var/external/bufr/nemtab.f

   1       SUBROUTINE NEMTAB(LUN,NEMO,IDN,TAB,IRET)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    NEMTAB
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE SEARCHES FOR MNEMONIC NEMO WITHIN THE
   9 C   INTERNAL TABLE B AND D ARRAYS HOLDING THE DICTIONARY TABLE (ARRAYS
  10 C   IN COMMON BLOCK /TABABD/) AND, IF FOUND, RETURNS INFORMATION ABOUT
  11 C   THAT MNEMONIC FROM WITHIN THESE ARRAYS.  OTHERWISE, IT CHECKS
  12 C   WHETHER NEMO IS A TABLE C OPERATOR DESCRIPTOR AND, IF SO, DIRECTLY
  13 C   COMPUTES AND RETURNS SIMILAR INFORMATION ABOUT THAT DESCRIPTOR.
  14 C   THIS SUBROUTINE MAY BE USEFUL TO APPLICATION PROGRAMS WHICH WANT
  15 C   TO CHECK WHETHER A PARTICULAR MNEMONIC IS IN THE DICTIONARY.  IN
  16 C   THIS CASE, BUFR ARCHIVE LIBRARY SUBROUTINE OPENBF MUST FIRST BE
  17 C   CALLED TO STORE THE DICTIONARY TABLE INTERNALLY, AND BUFR ARCHIVE
  18 C   LIBRARY SUBROUTINE STATUS MUST BE CALLED TO CONNECT THE LOGICAL
  19 C   UNIT NUMBER FOR THE BUFR FILE OPENED IN OPENBF TO LUN.
  20 C
  21 C PROGRAM HISTORY LOG:
  22 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  23 C 1995-06-28  J. WOOLLEN -- INCREASED THE SIZE OF INTERNAL BUFR TABLE
  24 C                           ARRAYS IN ORDER TO HANDLE BIGGER FILES
  25 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  26 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  27 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  28 C                           BUFR FILES UNDER THE MPI)
  29 C 2000-09-19  J. WOOLLEN -- ADDED CAPABILITY TO ENCODE AND DECODE DATA
  30 C                           USING THE OPERATOR DESCRIPTORS (BUFR TABLE
  31 C                           C) FOR CHANGING WIDTH AND CHANGING SCALE
  32 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  33 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  34 C                           INTERDEPENDENCIES
  35 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  36 C                           DOCUMENTATION
  37 C 2005-11-29  J. ATOR    -- ADDED SUPPORT FOR 207 AND 208 OPERATORS
  38 C 2010-03-19  J. ATOR    -- ADDED SUPPORT FOR 204 AND 205 OPERATORS
  39 C 2012-03-02  J. ATOR    -- ADDED SUPPORT FOR 203 OPERATOR
  40 C
  41 C USAGE:    CALL NEMTAB (LUN, NEMO, IDN, TAB, IRET)
  42 C   INPUT ARGUMENT LIST:
  43 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  44 C     NEMO     - CHARACTER*(*): MNEMONIC TO SEARCH FOR
  45 C
  46 C   OUTPUT ARGUMENT LIST:
  47 C     IDN      - INTEGER: BIT-WISE REPRESENTATION OF FXY VALUE
  48 C                CORRESPONDING TO NEMO (IF NEMO WAS FOUND)
  49 C     TAB      - CHARACTER*1: INTERNAL TABLE ARRAY IN WHICH NEMO WAS
  50 C                FOUND:
  51 C                     'B' = Table B array
  52 C                     'C' = Table C array
  53 C                     'D' = Table D array
  54 C     IRET     - INTEGER: POSITIONAL INDEX OF NEMO WITHIN TAB
  55 C                       0 = NEMO was not found within any of the Table
  56 C                           B, C, or D arrays
  57 C
  58 C REMARKS:
  59 C    THIS ROUTINE CALLS:        IFXY
  60 C    THIS ROUTINE IS CALLED BY: CHEKSTAB CMSGINI  ELEMDX   MSGINI
  61 C                               SEQSDX   STSEQ    TABSUB   UFBDMP
  62 C                               UFBQCD   UFDUMP   UPFTBV
  63 C                               Also called by application programs
  64 C                               (see ABSTRACT).
  65 C
  66 C ATTRIBUTES:
  67 C   LANGUAGE: FORTRAN 77
  68 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  69 C
  70 C$$$
  71
  72       INCLUDE 'bufrlib.prm'
  73
  74       COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
  75      .                MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
  76      .                IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
  77      .                TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
  78      .                TABD(MAXTBD,NFILES)
  79
  80       CHARACTER*(*) NEMO
  81       CHARACTER*600 TABD
  82       CHARACTER*128 TABB
  83       CHARACTER*128 TABA
  84       CHARACTER*8   NEMT
  85       CHARACTER*1   TAB
  86       LOGICAL       FOLVAL
  87
  88 C-----------------------------------------------------------------------
  89 C-----------------------------------------------------------------------
  90
  91       FOLVAL = NEMO(1:1).EQ.'.'
  92       IRET = 0
  93       TAB = ' '
  94
  95 C  LOOK FOR NEMO IN TABLE B
  96 C  ------------------------
  97
  98       DO 1 I=1,NTBB(LUN)
  99       NEMT = TABB(I,LUN)(7:14)
 100       IF(NEMT.EQ.NEMO) THEN
 101          IDN  = IDNB(I,LUN)
 102          TAB  = 'B'
 103          IRET = I
 104          GOTO 100
 105       ELSEIF(FOLVAL.AND.NEMT(1:1).EQ.'.') THEN
 106          DO J=2,LEN(NEMT)
 107          IF(NEMT(J:J).NE.'.' .AND. NEMT(J:J).NE.NEMO(J:J)) GOTO 1
 108          ENDDO
 109          IDN  = IDNB(I,LUN)
 110          TAB  = 'B'
 111          IRET = I
 112          GOTO 100
 113       ENDIF
 114 1     ENDDO
 115
 116 C  DON'T LOOK IN TABLE D FOR FOLLOWING VALUE-MNEMONICS
 117 C  ---------------------------------------------------
 118
 119       IF(FOLVAL) GOTO 100
 120
 121 C  LOOK IN TABLE D IF WE GOT THIS FAR
 122 C  ----------------------------------
 123
 124       DO I=1,NTBD(LUN)
 125       NEMT = TABD(I,LUN)(7:14)
 126       IF(NEMT.EQ.NEMO) THEN
 127          IDN  = IDND(I,LUN)
 128          TAB  = 'D'
 129          IRET = I
 130          GOTO 100
 131       ENDIF
 132       ENDDO
 133
 134 C  IF STILL NOTHING, CHECK HERE FOR TABLE C OPERATOR DESCRIPTORS
 135 C  -------------------------------------------------------------
 136
 137       IF ( (NEMO(1:2).EQ.'20') .AND.
 138      .    ( LGE(NEMO(3:3),'1') .AND. LLE(NEMO(3:3),'8') ) ) THEN
 139          READ(NEMO,'(1X,I2)') IRET
 140          IDN = IFXY(NEMO)
 141          TAB = 'C'
 142          GOTO 100
 143       ENDIF
 144
 145 C  EXIT
 146 C  ----
 147
 148 100   RETURN
 149       END