nemtab.f

Go to the documentation of this file.

C> @file
C> @brief Get information about a descriptor, based on the mnemonic.
C>
C> @author J. Woollen @date 1994-01-06
 
C> Get information about a descriptor, based on the mnemonic.
C>
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> @param[in] LUN - integer: File ID.
C> @param[in] NEMO - character*(*): Mnemonic.
C> @param[out] IDN - integer: WMO 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 Table B, if TAB = 'B'.
C> - Positional index of IDN within internal Table D, if TAB = 'D'.
C> - The X portion of the FXY value in IDN, if TAB = 'C'.
C> - 0, otherwise
C>
C> @author J. Woollen @date 1994-01-06
 
      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