var/external/bufr/numtab.f

   1       SUBROUTINE NUMTAB(LUN,IDN,NEMO,TAB,IRET)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    NUMTAB
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE FIRST SEARCHES FOR AN INTEGER IDN,
   9 C   CONTAINING THE BIT-WISE REPRESENTATION OF A DESCRIPTOR (FXY) VALUE,
  10 C   WITHIN THE INTERNAL BUFR REPLICATION ARRAYS IN COMMON BLOCK /REPTAB/
  11 C   TO SEE IF IDN IS A REPLICATION DESCRIPTOR OR A REPLICATION FACTOR
  12 C   DESCRIPTOR.  IF THIS SEARCH IS UNSUCCESSFUL, IT SEACHES FOR IDN
  13 C   WITHIN THE INTERNAL BUFR TABLE D AND B ARRAYS TO SEE IF IDN IS A
  14 C   TABLE D OR TABLE B DESCRIPTOR.  IF THIS SEARCH IS ALSO UNSUCCESSFUL,
  15 C   IT SEARCHES TO SEE IF IDN IS A TABLE C OPERATOR DESCRIPTOR.  IF IDN
  16 C   IS FOUND IN ANY OF THESE SEARCHES, THIS SUBROUTINE RETURNS THE
  17 C   CORRESPONDING MNEMONIC AND OTHER INFORMATION FROM WITHIN EITHER THE
  18 C   INTERNAL ARRAYS FOR REPLICATION, REPLICATION FACTOR, TABLE D OR
  19 C   TABLE B DESCRIPTORS, OR ELSE FROM THE KNOWN VALUES FOR TABLE C
  20 C   DESCRIPTORS.  IF IDN IS NOT FOUND, IT RETURNS WITH IRET=0.
  21 C
  22 C PROGRAM HISTORY LOG:
  23 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  24 C 1995-06-28  J. WOOLLEN -- INCREASED THE SIZE OF INTERNAL BUFR TABLE
  25 C                           ARRAYS IN ORDER TO HANDLE BIGGER FILES
  26 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  27 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  28 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  29 C                           BUFR FILES UNDER THE MPI)
  30 C 2000-09-19  J. WOOLLEN -- ADDED CAPABILITY TO ENCODE AND DECODE DATA
  31 C                           USING THE OPERATOR DESCRIPTORS (BUFR TABLE
  32 C                           C) FOR CHANGING WIDTH AND CHANGING SCALE
  33 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  34 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  35 C                           INTERDEPENDENCIES
  36 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  37 C                           DOCUMENTATION; CORRECTED TYPO ("IDN" WAS
  38 C                           SPECIFIED AS "ID" IN CALCULATION OF IRET
  39 C                           FOR TAB='C')
  40 C 2005-11-29  J. ATOR    -- ADDED SUPPORT FOR 207 AND 208 OPERATORS
  41 C 2009-04-21  J. ATOR    -- USE NUMTBD
  42 C 2010-03-19  J. ATOR    -- ADDED SUPPORT FOR 204 AND 205 OPERATORS
  43 C 2012-03-02  J. ATOR    -- ADDED SUPPORT FOR 203 OPERATOR
  44 C
  45 C USAGE:    CALL NUMTAB (LUN, IDN, NEMO, TAB, IRET)
  46 C   INPUT ARGUMENT LIST:
  47 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  48 C     IDN      - INTEGER: BIT-WISE REPRESENTATION OF DESCRIPTOR (FXY)
  49 C                VALUE
  50 C
  51 C   OUTPUT ARGUMENT LIST:
  52 C     NEMO     - CHARACTER*(*): MNEMONIC CORRESPONDING TO IDN
  53 C     TAB      - CHARACTER*1: TYPE OF FXY VALUE THAT IS BIT-WISE
  54 C                REPRESENTED BY IDN:
  55 C                     'B' = BUFR Table B descriptor
  56 C                     'C' = BUFR Table C descriptor
  57 C                     'D' = BUFR Table D descriptor
  58 C                     'R' = BUFR replication descriptor
  59 C                     'F' = BUFR replication factor descriptor
  60 C     IRET     - INTEGER: RETURN VALUE (SEE REMARKS)
  61 C
  62 C REMARKS:
  63 C    THE INTERPRETATION OF THE RETURN VALUE IRET DEPENDS UPON THE
  64 C    RETURN VALUE OF TAB AND THE INPUT VALUE IDN, AS FOLLOWS:
  65 C
  66 C    IF ( TAB = 'B' ) THEN
  67 C       IRET = positional index of IDN within internal BUFR Table B
  68 C              array
  69 C    ELSE IF ( TAB = 'C') THEN
  70 C       IRET = the X portion of the FXY value that is bit-wise
  71 C              represented by IDN
  72 C    ELSE IF ( TAB = 'D') THEN
  73 C       IRET = positional index of IDN within internal BUFR Table D
  74 C              array
  75 C    ELSE IF ( TAB = 'R') THEN
  76 C       IF ( IDN denoted regular (i.e. non-delayed) replication ) THEN
  77 C          IRET = ((-1)*Y), where Y is the number of replications
  78 C       ELSE ( i.e. delayed replication )
  79 C          IRET = positional index (=I) of IDN within internal
  80 C                 replication descriptor array IDNR(I,1), where:
  81 C               IRET (=I) =2 --> 16-bit delayed replication descriptor
  82 C               IRET (=I) =3 -->  8-bit delayed replication descriptor
  83 C               IRET (=I) =4 -->  8-bit delayed replication descriptor
  84 C                                 (stack)
  85 C               IRET (=I) =5 -->  1-bit delayed replication descriptor
  86 C       END IF
  87 C    ELSE IF ( TAB = 'F') THEN
  88 C       IRET = positional index (=I) of IDN within internal replication
  89 C              factor array IDNR(I,2), where:
  90 C            IRET (=I) =2 --> 16-bit replication factor
  91 C            IRET (=I) =3 -->  8-bit replication factor
  92 C            IRET (=I) =4 -->  8-bit replication factor
  93 C                              (stack)
  94 C            IRET (=I) =5 -->  1-bit replication factor
  95 C    ELSE IF ( IRET = 0 ) THEN
  96 C       IDN was not found in internal BUFR Table B or D, nor does it
  97 C       represent a Table C operator descriptor, a replication
  98 C       descriptor, or a replication factor descriptor
  99 C    END IF
 100 C
 101 C
 102 C    THIS ROUTINE CALLS:        ADN30    NUMTBD
 103 C    THIS ROUTINE IS CALLED BY: CKTABA   NEMTBD   SEQSDX   STNDRD
 104 C                               UFBQCP
 105 C                               Normally not called by any application
 106 C                               programs.
 107 C
 108 C ATTRIBUTES:
 109 C   LANGUAGE: FORTRAN 77
 110 C   MACHINE:  PORTABLE TO ALL PLATFORMS
 111 C
 112 C$$$
 113
 114       INCLUDE 'bufrlib.prm'
 115
 116 C     Note that the values within the COMMON /REPTAB/ arrays were
 117 C     initialized within subroutine BFRINI.
 118
 119       COMMON /REPTAB/ IDNR(5,2),TYPS(5,2),REPS(5,2),LENS(5)
 120
 121       CHARACTER*(*) NEMO
 122       CHARACTER*6   ADN30,CID
 123       CHARACTER*3   TYPS
 124       CHARACTER*1   REPS,TAB
 125
 126 C-----------------------------------------------------------------------
 127 C-----------------------------------------------------------------------
 128
 129       NEMO = ' '
 130       IRET = 0
 131       TAB = ' '
 132
 133 C  LOOK FOR A REPLICATOR OR A REPLICATION FACTOR DESCRIPTOR
 134 C  --------------------------------------------------------
 135
 136       IF(IDN.GE.IDNR(1,1) .AND. IDN.LE.IDNR(1,2)) THEN
 137
 138 C        Note that the above test is checking whether IDN is the bit-
 139 C        wise representation of a FXY (descriptor) value denoting F=1
 140 C        regular (i.e. non-delayed) replication, since, as was
 141 C        initialized within subroutine BFRINI,
 142 C        IDNR(1,1) = IFXY('101000'), and IDNR(1,2) = IFXY('101255').
 143
 144          TAB  = 'R'
 145          IRET = -MOD(IDN,256)
 146          GOTO 100
 147       ENDIF
 148
 149       DO I=2,5
 150          IF(IDN.EQ.IDNR(I,1)) THEN
 151             TAB  = 'R'
 152             IRET = I
 153             GOTO 100
 154          ELSEIF(IDN.EQ.IDNR(I,2)) THEN
 155             TAB  = 'F'
 156             IRET = I
 157             GOTO 100
 158          ENDIF
 159       ENDDO
 160
 161 C  LOOK FOR IDN IN TABLE B AND TABLE D
 162 C  -----------------------------------
 163
 164       CALL NUMTBD(LUN,IDN,NEMO,TAB,IRET)
 165       IF(IRET.NE.0) GOTO 100
 166
 167 C  LOOK FOR IDN IN TABLE C
 168 C  -----------------------
 169
 170       CID = ADN30(IDN,6)
 171       IF ( (CID(1:2).EQ.'20') .AND.
 172      .    ( LGE(CID(3:3),'1') .AND. LLE(CID(3:3),'8') ) ) THEN
 173          NEMO = CID(1:6)
 174          READ(NEMO,'(1X,I2)') IRET
 175          TAB  = 'C'
 176          GOTO 100
 177       ENDIF
 178
 179 C  EXIT
 180 C  ----
 181
 182 100   RETURN
 183       END