var/external/bufr/readmt.f

   1         SUBROUTINE READMT ( IMT, IMTV, IOGCE, IMTVL )
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    READMT
   6 C   PRGMMR: ATOR            ORG: NP12       DATE: 2009-03-23
   7 C
   8 C ABSTRACT:  THIS SUBROUTINE OPENS AND READS BUFR MASTER TABLES AS
   9 C   SPECIFIED BY THE INPUT ARGUMENTS AND USING ADDITIONAL INFORMATION
  10 C   AS WAS DEFINED IN THE MOST RECENT CALL TO BUFR ARCHIVE LIBRARY
  11 C   SUBROUTINE MTINFO (OR AS WAS DEFINED WITHIN BUFR ARCHIVE LIBRARY
  12 C   SUBROUTINE BFRINI, IF SUBROUTINE MTINFO WAS NEVER CALLED).
  13 C
  14 C PROGRAM HISTORY LOG:
  15 C 2009-03-23  J. ATOR    -- ORIGINAL AUTHOR
  16 C
  17 C USAGE:    CALL READMT ( IMT, IMTV, IOGCE, IMTVL )
  18 C   INPUT ARGUMENT LIST:
  19 C     IMT      - INTEGER: MASTER TABLE NUMBER
  20 C     IMTV     - INTEGER: MASTER TABLE VERSION NUMBER
  21 C     IOGCE    - INTEGER: ORIGINATING CENTER
  22 C     IMTVL    - INTEGER: LOCAL TABLE VERSION NUMBER
  23 C
  24 C   INPUT FILES:
  25 C     UNITS 98,99  - IF SUBROUTINE MTINFO WAS NEVER CALLED, THEN THESE
  26 C                    LOGICAL UNIT NUMBERS ARE USED BY THIS ROUTINE FOR
  27 C                    OPENING AND READING THE BUFR MASTER TABLES.
  28 C                    ALTERNATIVELY, IF SUBROUTINE MTINFO WAS CALLED,
  29 C                    THEN THE LOGICAL UNIT NUMBERS SPECIFIED IN THE
  30 C                    MOST RECENT CALL TO MTINFO (ARGUMENTS LUNMT1 AND
  31 C                    LUNMT2) ARE USED INSTEAD.
  32 C REMARKS:
  33 C    THIS ROUTINE CALLS:        BORT2    ERRWRT   ICVIDX   IGETTDI
  34 C                               RDMTBB   RDMTBD
  35 C    THIS ROUTINE IS CALLED BY: READS3
  36 C                               Not normally called by any application
  37 C                               programs but it could be.
  38 C
  39 C ATTRIBUTES:
  40 C   LANGUAGE: FORTRAN 77
  41 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  42 C
  43 C$$$
  44
  45         INCLUDE 'bufrlib.prm'
  46
  47         COMMON /QUIET/  IPRT
  48         COMMON /MSTINF/ LUN1, LUN2, LMTD, MTDIR
  49         COMMON /MSTABS/ NMTB, IBFXYN(MXMTBB), CBSCL(MXMTBB),
  50      .                        CBSREF(MXMTBB), CBBW(MXMTBB),
  51      .                        CBUNIT(MXMTBB), CBMNEM(MXMTBB),
  52      .                        CBELEM(MXMTBB),
  53      .                  NMTD, IDFXYN(MXMTBD), CDSEQ(MXMTBD),
  54      .                        CDMNEM(MXMTBD), NDELEM(MXMTBD),
  55      .                        IDEFXY(MXMTBD*MAXCD),
  56      .                        CDELEM(MXMTBD*MAXCD)
  57
  58         DIMENSION       IMFXYB(MXMTBB), IMFXYD(MXMTBD),
  59      .                  NMELEM(MXMTBD), IEFXYN(MXMTBD,MAXCD)
  60         CHARACTER*4     CMDSCB(MXMTBB), CMDSCD(MXMTBD),
  61      .                  CBSCL, CMSCL(MXMTBB),
  62      .                  CBBW, CMBW(MXMTBB)
  63         CHARACTER*8     CBMNEM, CMMNMB(MXMTBB),
  64      .                  CDMNEM, CMMNMD(MXMTBD)
  65         CHARACTER*12    CBSREF, CMSREF(MXMTBB)
  66         CHARACTER*14    CBUNIT, CMUNIT(MXMTBB)
  67         CHARACTER*20    FMTF
  68         CHARACTER*100   MTDIR
  69         CHARACTER*120   CBELEM, CMELEM(MXMTBB),
  70      .                  CDSEQ, CMSEQ(MXMTBD),
  71      .                  CDELEM, CEELEM(MXMTBD,MAXCD)
  72         CHARACTER*128   BORT_STR
  73         CHARACTER*132   TBLFIL,STDFIL,LOCFIL1,LOCFIL2
  74         LOGICAL         FOUND
  75
  76 C-----------------------------------------------------------------------
  77 C-----------------------------------------------------------------------
  78
  79 C*      Reset the scratch table D index for this master table.
  80
  81         ITMP = IGETTDI ( 0 )
  82
  83         IF ( IPRT .GE. 2 ) THEN
  84         CALL ERRWRT(' ')
  85         CALL ERRWRT('+++++++++++++++++++++++++++++++++++++++++++++++++')
  86         CALL ERRWRT('BUFRLIB: READMT - OPENING/READING MASTER TABLES')
  87         ENDIF
  88
  89 C*      Locate and open the master Table B files.  There should be one
  90 C*      file of standard descriptors and one file of local descriptors.
  91
  92 C*      First locate and open the file of standard Table B descriptors.
  93
  94         IF ( ( IMT .EQ. 0 ) .AND. ( IMTV .LE. 13 ) ) THEN
  95
  96 C*        For master table 0, version 13 is a superset of all earlier
  97 C*        versions.
  98
  99           STDFIL = MTDIR(1:LMTD) // '/' // 'bufrtab.TableB_STD_0_13'
 100         ELSE
 101           WRITE ( FMTF, '(A,I1,A,I1,A)' )
 102      .       '(2A,I', ISIZE(IMT), ',A,I', ISIZE(IMTV), ')'
 103           WRITE ( STDFIL, FMTF ) MTDIR(1:LMTD), '/bufrtab.TableB_STD_',
 104      .       IMT, '_', IMTV
 105         ENDIF
 106         TBLFIL = STDFIL
 107         IF ( IPRT .GE. 2 ) THEN
 108           CALL ERRWRT('Standard Table B:')
 109           CALL ERRWRT(TBLFIL)
 110         ENDIF
 111         INQUIRE ( FILE = TBLFIL, EXIST = FOUND )
 112         IF ( .NOT. FOUND ) GOTO 900
 113         OPEN ( UNIT = LUN1, FILE = TBLFIL, IOSTAT = IER )
 114         IF ( IER .NE. 0 ) GOTO 901
 115
 116 C*      Now locate and open the file of local Table B descriptors.
 117
 118 C*      Use the local table corresponding to the originating center
 119 C*      and local table version number of the current message, if such
 120 C*      a table exists.  Otherwise use the NCEP local table B.
 121
 122         LOCFIL2 = MTDIR(1:LMTD) // '/' // 'bufrtab.TableB_LOC_0_7_1'
 123         WRITE ( FMTF, '(A,I1,A,I1,A,I1,A)' )
 124      .     '(2A,I', ISIZE(IMT), ',A,I', ISIZE(IOGCE),
 125      .     ',A,I',  ISIZE(IMTVL), ')'
 126         WRITE ( LOCFIL1, FMTF ) MTDIR(1:LMTD), '/bufrtab.TableB_LOC_',
 127      .     IMT, '_', IOGCE, '_', IMTVL
 128         TBLFIL = LOCFIL1
 129         IF ( IPRT .GE. 2 ) THEN
 130           CALL ERRWRT('Local Table B:')
 131           CALL ERRWRT(TBLFIL)
 132         ENDIF
 133         INQUIRE ( FILE = TBLFIL, EXIST = FOUND )
 134         IF ( .NOT. FOUND ) THEN
 135
 136 C*        Use the NCEP local table B.
 137
 138           TBLFIL = LOCFIL2
 139           IF ( IPRT .GE. 2 ) THEN
 140             CALL ERRWRT('Local Table B not found, so using:')
 141             CALL ERRWRT(TBLFIL)
 142           ENDIF
 143           INQUIRE ( FILE = TBLFIL, EXIST = FOUND )
 144           IF ( .NOT. FOUND ) GOTO 900
 145         ENDIF
 146         OPEN ( UNIT = LUN2, FILE = TBLFIL, IOSTAT = IER )
 147         IF ( IER .NE. 0 ) GOTO 901
 148
 149 C*      Read the master Table B files.
 150
 151         CALL RDMTBB ( LUN1, LUN2, MXMTBB,
 152      .                IBMT, IBMTV, IBOGCE, IBLTV,
 153      .                NMTBB, IMFXYB, CMSCL, CMSREF, CMBW,
 154      .                CMUNIT, CMMNMB, CMDSCB, CMELEM )
 155
 156 C*      Save the output into COMMON /MSTABS/.
 157
 158         NMTB = NMTBB
 159         DO I = 1, NMTB
 160           IBFXYN(I) = IMFXYB(I)
 161           CBSCL(I) = CMSCL(I)
 162           CBSREF(I) = CMSREF(I)
 163           CBBW(I) = CMBW(I)
 164           CBUNIT(I) = CMUNIT(I)
 165           CBMNEM(I) = CMMNMB(I)
 166           CBELEM(I) = CMELEM(I)
 167         ENDDO
 168
 169 C*      Close the master Table B files.
 170
 171         CLOSE ( UNIT = LUN1 )
 172         CLOSE ( UNIT = LUN2 )
 173
 174 C*      Locate and open the master Table D files.  There should be one
 175 C*      file of standard descriptors and one file of local descriptors.
 176
 177 C*      First locate and open the file of standard Table D descriptors.
 178
 179         TBLFIL = STDFIL
 180         TBLFIL(LMTD+15:LMTD+15) = 'D'
 181         IF ( IPRT .GE. 2 ) THEN
 182           CALL ERRWRT('Standard Table D:')
 183           CALL ERRWRT(TBLFIL)
 184         ENDIF
 185         INQUIRE ( FILE = TBLFIL, EXIST = FOUND )
 186         IF ( .NOT. FOUND ) GOTO 900
 187         OPEN ( UNIT = LUN1, FILE = TBLFIL, IOSTAT = IER )
 188         IF ( IER .NE. 0 ) GOTO 901
 189
 190 C*      Now locate and open the file of local Table D descriptors.
 191
 192 C*      Use the local table corresponding to the originating center
 193 C*      and local table version number of the current message, if such
 194 C*      a table exists.  Otherwise use the NCEP local table D.
 195
 196         TBLFIL = LOCFIL1
 197         TBLFIL(LMTD+15:LMTD+15) = 'D'
 198         IF ( IPRT .GE. 2 ) THEN
 199           CALL ERRWRT('Local Table D:')
 200           CALL ERRWRT(TBLFIL)
 201         ENDIF
 202         INQUIRE ( FILE = TBLFIL, EXIST = FOUND )
 203         IF ( .NOT. FOUND ) THEN
 204
 205 C*        Use the NCEP local table D.
 206
 207           TBLFIL = LOCFIL2
 208           TBLFIL(LMTD+15:LMTD+15) = 'D'
 209           IF ( IPRT .GE. 2 ) THEN
 210             CALL ERRWRT('Local Table D not found, so using:')
 211             CALL ERRWRT(TBLFIL)
 212           ENDIF
 213           INQUIRE ( FILE = TBLFIL, EXIST = FOUND )
 214           IF ( .NOT. FOUND ) GOTO 900
 215         ENDIF
 216         OPEN ( UNIT = LUN2, FILE = TBLFIL, IOSTAT = IER )
 217         IF ( IER .NE. 0 ) GOTO 901
 218
 219 C*      Read the master Table D files.
 220
 221         CALL RDMTBD ( LUN1, LUN2, MXMTBD, MAXCD,
 222      .                IDMT, IDMTV, IDOGCE, IDLTV,
 223      .                NMTBD, IMFXYD, CMMNMD, CMDSCD, CMSEQ,
 224      .                NMELEM, IEFXYN, CEELEM )
 225
 226 C*      Save the output into COMMON /MSTABS/.
 227
 228         NMTD = NMTBD
 229         DO I = 1, NMTD
 230           IDFXYN(I) = IMFXYD(I)
 231           CDMNEM(I) = CMMNMD(I)
 232           CDSEQ(I) = CMSEQ(I)
 233           NDELEM(I) = NMELEM(I)
 234           DO J = 1, NDELEM(I)
 235             IDX = ICVIDX ( I-1, J-1, MAXCD ) + 1
 236             IDEFXY(IDX) = IEFXYN(I,J)
 237             CDELEM(IDX) = CEELEM(I,J)
 238           ENDDO
 239         ENDDO
 240
 241 C*      Close the master Table D files.
 242
 243         CLOSE ( UNIT = LUN1 )
 244         CLOSE ( UNIT = LUN2 )
 245
 246         IF ( IPRT .GE. 2 ) THEN
 247         CALL ERRWRT('+++++++++++++++++++++++++++++++++++++++++++++++++')
 248         CALL ERRWRT(' ')
 249         ENDIF
 250
 251         RETURN
 252 900     BORT_STR = 'BUFRLIB: READMT - COULD NOT FIND FILE:'
 253         CALL BORT2(BORT_STR,TBLFIL)
 254 901     BORT_STR = 'BUFRLIB: READMT - COULD NOT OPEN FILE:'
 255         CALL BORT2(BORT_STR,TBLFIL)
 256         END