nemtab.f

Go to the documentation of this file.

C> @file
C> @author WOOLLEN @date 1994-01-06
      
C> THIS SUBROUTINE SEARCHES FOR MNEMONIC NEMO WITHIN THE
C>   INTERNAL TABLE B AND D ARRAYS HOLDING THE DICTIONARY TABLE (ARRAYS
C>   IN MODULE TABABD) AND, IF FOUND, RETURNS INFORMATION ABOUT
C>   THAT MNEMONIC FROM WITHIN THESE ARRAYS.  OTHERWISE, IT CHECKS
C>   WHETHER NEMO IS A TABLE C OPERATOR DESCRIPTOR AND, IF SO, DIRECTLY
C>   COMPUTES AND RETURNS SIMILAR INFORMATION ABOUT THAT DESCRIPTOR.
C>   THIS SUBROUTINE MAY BE USEFUL TO APPLICATION PROGRAMS WHICH WANT
C>   TO CHECK WHETHER A PARTICULAR MNEMONIC IS IN THE DICTIONARY.  IN
C>   THIS CASE, BUFR ARCHIVE LIBRARY SUBROUTINE OPENBF MUST FIRST BE
C>   CALLED TO STORE THE DICTIONARY TABLE INTERNALLY, AND BUFR ARCHIVE
C>   LIBRARY SUBROUTINE STATUS MUST BE CALLED TO CONNECT THE LOGICAL
C>   UNIT NUMBER FOR THE BUFR FILE OPENED IN OPENBF TO LUN.
C>
C> PROGRAM HISTORY LOG:
C> 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C> 1995-06-28  J. WOOLLEN -- INCREASED THE SIZE OF INTERNAL BUFR TABLE
C>                           ARRAYS IN ORDER TO HANDLE BIGGER FILES
C> 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
C>                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
C>                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
C>                           BUFR FILES UNDER THE MPI)
C> 2000-09-19  J. WOOLLEN -- ADDED CAPABILITY TO ENCODE AND DECODE DATA
C>                           USING THE OPERATOR DESCRIPTORS (BUFR TABLE
C>                           C) FOR CHANGING WIDTH AND CHANGING SCALE
C> 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
C> 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
C>                           INTERDEPENDENCIES
C> 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
C>                           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> 2014-12-10  J. ATOR    -- USE MODULES INSTEAD OF COMMON BLOCKS
C> 2015-02-25  J. ATOR    -- ALLOW PROCESSING OF 2-2X, 2-3X AND 2-4X
C>                           NON-MARKER OPERATORS IN DX TABLES
C>
C> USAGE:    CALL NEMTAB (LUN, NEMO, IDN, TAB, IRET)
C>   INPUT ARGUMENT LIST:
C>     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C>     NEMO     - CHARACTER*(*): MNEMONIC TO SEARCH FOR
C>
C>   OUTPUT ARGUMENT LIST:
C>     IDN      - INTEGER: BIT-WISE REPRESENTATION OF FXY VALUE
C>                CORRESPONDING TO NEMO (IF NEMO WAS FOUND)
C>     TAB      - CHARACTER*1: INTERNAL TABLE ARRAY IN WHICH NEMO WAS
C>                FOUND:
C>                     'B' = Table B array
C>                     'C' = Table C array
C>                     'D' = Table D array
C>     IRET     - INTEGER: POSITIONAL INDEX OF NEMO WITHIN TAB
C>                       0 = NEMO was not found within any of the Table
C>                           B, C, or D arrays
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        IFXY     IOKOPER
C>    THIS ROUTINE IS CALLED BY: CHEKSTAB CMSGINI  ELEMDX   GETCFMNG
C>                               IGETRFEL MSGINI   NEMDEFS  SEQSDX
C>                               STSEQ    TABSUB   UFBDMP   UFBQCD
C>                               UFDUMP   UPFTBV
C>                               Also called by application programs
C>                               (see ABSTRACT).
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