numtbd.f

Go to the documentation of this file.

C> @file
C> @author WOOLLEN @date 2002-05-14
      
C> THIS SUBROUTINE SEARCHES FOR AN INTEGER IDN, CONTAINING THE
C>   BIT-WISE REPRESENTATION OF A DESCRIPTOR (FXY) VALUE, WITHIN THE
C>   INTERNAL BUFR TABLE B AND D ARRAYS IN MODULE TABABD.  IF FOUND,
C>   IT RETURNS THE CORRESPONDING MNEMONIC AND OTHER INFORMATION FROM
C>   WITHIN THESE ARRAYS.  IF IDN IS NOT FOUND, IT RETURNS WITH IRET=0.
C>
C> PROGRAM HISTORY LOG:
C> 2002-05-14  J. WOOLLEN -- ORIGINAL AUTHOR
C> 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
C>                           INTERDEPENDENCIES
C> 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
C>                           DOCUMENTATION (INCLUDING HISTORY)
C> 2009-04-21  J. ATOR    -- USE IFXY FOR MORE EFFICIENT SEARCHING
C> 2014-12-10  J. ATOR    -- USE MODULES INSTEAD OF COMMON BLOCKS
C>
C> USAGE:    CALL NUMTBD (LUN, IDN, NEMO, TAB, IRET)
C>   INPUT ARGUMENT LIST:
C>     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C>     IDN      - INTEGER: BIT-WISE REPRESENTATION OF DESCRIPTOR (FXY)
C>                VALUE
C>
C>   OUTPUT ARGUMENT LIST:
C>     NEMO     - CHARACTER*(*): MNEMONIC CORRESPONDING TO IDN
C>     TAB      - CHARACTER*1: TYPE OF FXY VALUE THAT IS BIT-WISE
C>                REPRESENTED BY IDN:
C>                     'B' = BUFR Table B descriptor
C>                     'D' = BUFR Table D descriptor
C>     IRET     - INTEGER: RETURN VALUE (SEE REMARKS)
C>
C> REMARKS:
C>    THE INTERPRETATION OF THE RETURN VALUE IRET DEPENDS UPON THE
C>    RETURN VALUE OF TAB, AS FOLLOWS:
C>
C>    IF ( TAB = 'B' ) THEN
C>       IRET = positional index of IDN within internal BUFR Table B
C>              array
C>    ELSE IF ( TAB = 'D') THEN
C>       IRET = positional index of IDN within internal BUFR Table D
C>              array
C>    ELSE IF ( IRET = 0 ) THEN
C>       IDN was not found in internal BUFR Table B or D
C>    END IF
C>
C>
C>    THIS ROUTINE CALLS:        IFXY
C>    THIS ROUTINE IS CALLED BY: GETCFMNG NUMTAB   RESTD    STSEQ
C>                               UFDUMP
C>                               Normally not called by any application
C>                               programs.
C>
      SUBROUTINE numtbd(LUN,IDN,NEMO,TAB,IRET)

      USE moda_tababd

      CHARACTER*(*) nemo
      CHARACTER*1   tab

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

      nemo = ' '
      iret = 0
      tab = ' '

      IF(idn.GE.ifxy('300000')) THEN

C        LOOK FOR IDN IN TABLE D
C        -----------------------

         DO i=1,ntbd(lun)
            IF(idn.EQ.idnd(i,lun)) THEN
               nemo = tabd(i,lun)(7:14)
               tab  = 'D'
               iret = i
               goto 100
            ENDIF
         ENDDO

      ELSE

C        LOOK FOR IDN IN TABLE B
C        -----------------------

         DO i=1,ntbb(lun)
            IF(idn.EQ.idnb(i,lun)) THEN
               nemo = tabb(i,lun)(7:14)
               tab  = 'B'
               iret = i
               goto 100
            ENDIF
         ENDDO

      ENDIF

C  EXIT
C  ----

100   RETURN
      END