nemtab.f

Go to the documentation of this file.

C> @file
C> @brief Get information about a descriptor, based on the mnemonic
 
C> This subroutine returns information about a descriptor from the
C> internal DX BUFR tables, based on the mnemonic associated with
C> that descriptor.
C>
C> @author J. Woollen
C> @date 1994-01-06
C>
C> @param[in] LUN -- integer: Internal I/O stream index associated
C>                   with DX BUFR tables
C> @param[in] NEMO -- character*(*): Mnemonic
C> @param[out] IDN -- integer: Bit-wise representation of FXY value
C>                    for descriptor associated with NEMO
C> @param[out] TAB -- character: Type associated with IDN
C>                     - 'B' = Table B descriptor
C>                     - 'D' = Table D descriptor
C>                     - 'C' = Table C operator
C> @param[out] IRET -- integer:
C>                     - Positional index of IDN within internal
C>                       Table B, if TAB = 'B'
C>                     - Positional index of IDN within internal
C>                       Table D, if TAB = 'D'
C>                     - The X portion of the FXY value in IDN, if
C>                       TAB = 'C'
C>                     - 0, otherwise
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 1994-01-06 | J. Woollen | Original author |
C> | 1995-06-28 | J. Woollen | Increased the size of internal BUFR table arrays in order to handle bigger files |
C> | 1999-11-18 | J. Woollen | The number of BUFR files which can be opened at one time increased from 10 to 32 |
C> | 2000-09-19 | J. Woollen | Added capability to encode and decode data using the operator descriptors (BUFR table C) for changing width and changing scale |
C> | 2003-11-04 | J. Ator    | Added documentation |
C> | 2003-11-04 | S. Bender  | Added remarks and routine interdependencies |
C> | 2003-11-04 | D. Keyser  | Unified/portable for WRF; added documentation |
C> | 2005-11-29 | J. Ator    | Added support for 207 and 208 operators |
C> | 2010-03-19 | J. Ator    | Added support for 204 and 205 operators |
C> | 2012-03-02 | J. Ator    | Added support for 203 operator |
C> | 2015-02-25 | J. Ator    | Allow processing of 2-2x, 2-3x and 2-4X non-marker operators in DX tables |
C>
      SUBROUTINE nemtab(LUN,NEMO,IDN,TAB,IRET)
 
      USE moda_tababd
 
      CHARACTER*(*) NEMO
      CHARACTER*8   NEMT
      CHARACTER*1   TAB
      LOGICAL       FOLVAL
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
      folval = nemo(1:1).EQ.'.'
      iret = 0
      tab = ' '
 
C  LOOK FOR NEMO IN TABLE B
C  ------------------------
 
      DO 1 i=1,ntbb(lun)
      nemt = tabb(i,lun)(7:14)
      IF(nemt.EQ.nemo) THEN
         idn  = idnb(i,lun)
         tab  = 'B'
         iret = i
         GOTO 100
      ELSEIF(folval.AND.nemt(1:1).EQ.'.') THEN
         DO j=2,len(nemt)
         IF(nemt(j:j).NE.'.' .AND. nemt(j:j).NE.nemo(j:j)) GOTO 1
         ENDDO
         idn  = idnb(i,lun)
         tab  = 'B'
         iret = i
         GOTO 100
      ENDIF
1     ENDDO
 
C  DON'T LOOK IN TABLE D FOR FOLLOWING VALUE-MNEMONICS
C  ---------------------------------------------------
 
      IF(folval) GOTO 100
 
C  LOOK IN TABLE D IF WE GOT THIS FAR
C  ----------------------------------
 
      DO i=1,ntbd(lun)
      nemt = tabd(i,lun)(7:14)
      IF(nemt.EQ.nemo) THEN
         idn  = idnd(i,lun)
         tab  = 'D'
         iret = i
         GOTO 100
      ENDIF
      ENDDO
 
C  IF STILL NOTHING, CHECK HERE FOR TABLE C OPERATOR DESCRIPTORS
C  -------------------------------------------------------------
 
      IF (iokoper(nemo).EQ.1) THEN
         READ(nemo,'(1X,I2)') iret
         idn = ifxy(nemo)
         tab = 'C'
         GOTO 100
      ENDIF
 
C  EXIT
C  ----
 
100   RETURN
      END