ireadmt.f

Go to the documentation of this file.

C> @file
C> @brief Check whether master BUFR tables need to be read from the
C> local file system.
C>
C> @author J. Ator @date 2009-03-23
 
C> Check whether master BUFR tables need to be read from the local
C> file system.
C>
C> This function checks the most recent BUFR message that was read
C> via a call to one of the
C> [message-reading subroutines](@ref hierarchy) and determines
C> whether the appropriate corresponding BUFR master tables have
C> already been read into internal memory.
C>
C> If not, then it opens the appropriate master BUFR tables on the
C> local file system and reads the contents into internal
C> memory, clearing any previous master BUFR table information that
C> may have previously been stored there.
C>
C> @param[in] LUN - integer: File ID.
C> @returns ireadmt - integer: Flag indicating whether new master
C> BUFR tables needed to be read into internal memory:
C> - 0 = No
C> - 1 = Yes
C>
C> Information about the location of master BUFR tables on the
C> local file system is obtained from the most recent call to
C> subroutine mtinfo(), or else from subroutine bfrini() if
C> subroutine mtinfo() was never called, and in which case Fortran
C> logical unit numbers 98 and 99 will be used by this function
C> for opening and reading master BUFR table files.
C>
C> @author J. Ator @date 2009-03-23
        INTEGER FUNCTION ireadmt ( LUN )
 
        use bufrlib
 
        USE modv_maxnc
        USE modv_maxcd
        USE modv_mxmtbb
        USE modv_mxmtbd
 
        USE moda_mstabs
        USE moda_bitbuf
        USE moda_rdmtb
        USE moda_sc3bfr
 
        COMMON /quiet/  iprt
        COMMON /mstinf/ lun1, lun2, lmtd, mtdir
        COMMON /tablef/ cdmf
 
        CHARACTER*1     cdmf
        CHARACTER*6     cds3(maxnc)
        CHARACTER*100   mtdir
        CHARACTER*128   bort_str
        CHARACTER*132   stdfil,locfil
        LOGICAL         allstd
 
C*      Initializing the following value ensures that new master tables
C*      are read during the first call to this subroutine.
 
        DATA    lmt /-99/
 
        SAVE    lmt, lmtv, logce, lmtvl
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
        ireadmt = 0
 
C*      Unpack some Section 1 information from the message that was
C*      most recently read.
 
        imt  = iupbs01( mbay(1,lun), 'BMT' )
        imtv = iupbs01( mbay(1,lun), 'MTV' )
        iogce = iupbs01( mbay(1,lun), 'OGCE' )
        imtvl = iupbs01( mbay(1,lun), 'MTVL' )
 
C*      Compare the master table and master table version numbers from
C*      this message to those from the message that was processed during
C*      the previous call to this subroutine.
 
        IF (  ( imt .NE. lmt )
     +          .OR.
     +      ( ( imt .NE. 0 ) .AND. ( imtv .NE. lmtv ) )
     +          .OR.
     +      ( ( imt .EQ. 0 ) .AND. ( imtv .NE. lmtv ) .AND.
     +        ( ( imtv .GT. 13 ) .OR. ( lmtv .GT. 13 ) ) )  )
     +    THEN
 
C*        Either the master table number has changed
C*              .OR.
C*        The master table number hasn't changed, but it isn't 0, and
C*        the table version number has changed
C*              .OR.
C*        The master table number hasn't changed and is 0, but the table
C*        version number has changed, and at least one of the table
C*        version numbers (i.e. the current or the previous) is greater
C*        than 13 (which is the last version that was a superset of all
C*        earlier versions of master table 0!)
 
C*        In any of these cases, we need to read in new tables!
 
          ireadmt = 1
        ELSE
 
C*        Unpack the list of Section 3 descriptors from the message and
C*        determine if any of them are local descriptors.
 
          CALL upds3 ( mbay(1,lun), maxnc, cds3, ncds3 )
          ii = 1
          allstd = .true.
          DO WHILE ( (allstd) .AND. (ii.LE.ncds3) )
            IF ( istdesc(ifxy(cds3(ii))) .EQ. 0 ) THEN
              allstd = .false.
            ELSE
              ii = ii + 1
            ENDIF
          ENDDO
 
C*        If there was at least one local (i.e. non-standard) descriptor,
C*        and if either the originating center or local table version
C*        number are different than those from the message that was
C*        processed during the previous call to this subroutine, then
C*        we need to read in new tables.
 
          IF ( ( .NOT. allstd ) .AND.
     +          ( ( iogce .NE. logce ) .OR. ( imtvl .NE. lmtvl ) ) )
     +        ireadmt = 1
 
        ENDIF
 
        IF ( ireadmt .EQ. 0 ) RETURN
 
        lmt  = imt
        lmtv = imtv
        logce = iogce
        lmtvl = imtvl
 
        IF ( iprt .GE. 2 ) THEN
        CALL errwrt(' ')
        CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++++++')
        CALL errwrt('BUFRLIB: IREADMT - OPENING/READING MASTER TABLES')
        ENDIF
 
        IF ( isc3(lun) .NE. 0 ) THEN
 
C*        Locate and open the master Table B files.  There should be one
C*        file of standard descriptors and one file of local descriptors.
 
          CALL mtfnam ( imt, imtv, iogce, imtvl, 'TableB',
     +                  stdfil, locfil )
          OPEN ( unit = lun1, file = stdfil, iostat = ier )
          IF ( ier .NE. 0 ) GOTO 900
          OPEN ( unit = lun2, file = locfil, iostat = ier )
          IF ( ier .NE. 0 ) GOTO 901
 
C*        Read the master Table B files.
 
          CALL rdmtbb ( lun1, lun2, mxmtbb,
     +                  ibmt, ibmtv, ibogce, ibltv,
     +                  nmtb, ibfxyn, cbscl, cbsref, cbbw,
     +                  cbunit, cbmnem, cmdscb, cbelem )
 
C*        Close the master Table B files.
 
          CLOSE ( unit = lun1 )
          CLOSE ( unit = lun2 )
 
C*        Locate and open the master Table D files.  There should be one
C*        file of standard descriptors and one file of local descriptors.
 
          CALL mtfnam ( imt, imtv, iogce, imtvl, 'TableD',
     +                  stdfil, locfil )
          OPEN ( unit = lun1, file = stdfil, iostat = ier )
          IF ( ier .NE. 0 ) GOTO 900
          OPEN ( unit = lun2, file = locfil, iostat = ier )
          IF ( ier .NE. 0 ) GOTO 901
 
C*        Read the master Table D files.
 
          CALL rdmtbd ( lun1, lun2, mxmtbd, maxcd,
     +                  idmt, idmtv, idogce, idltv,
     +                  nmtd, idfxyn, cdmnem, cmdscd, cdseq,
     +                  ndelem, iefxyn, ceelem )
          DO i = 1, nmtd
            DO j = 1, ndelem(i)
              idx = icvidx_c( i-1, j-1, maxcd ) + 1
              idefxy(idx) = iefxyn(i,j)
            ENDDO
          ENDDO
 
C*        Close the master Table D files.
 
          CLOSE ( unit = lun1 )
          CLOSE ( unit = lun2 )
 
C*        Copy master table B and D information into internal C arrays.
 
          CALL cpmstabs_c ( nmtb, ibfxyn, cbscl, cbsref, cbbw, cbunit,
     +                    cbmnem, cbelem, nmtd, idfxyn, cdseq, cdmnem,
     +                    ndelem, idefxy, maxcd )
        ENDIF
 
        IF ( cdmf .EQ. 'Y' ) THEN
 
C*        Locate and open the master code and flag table files.  There
C*        should be one file corresponding to the standard Table B
C*        descriptors, and one file corresponding to the local Table B
C*        descriptors.
 
          CALL mtfnam ( imt, imtv, iogce, imtvl, 'CodeFlag',
     +                stdfil, locfil )
          OPEN ( unit = lun1, file = stdfil, iostat = ier )
          IF ( ier .NE. 0 ) GOTO 900
          OPEN ( unit = lun2, file = locfil, iostat = ier )
          IF ( ier .NE. 0 ) GOTO 901
 
C*        Read the master code and flag table files.
 
          CALL rdmtbf ( lun1, lun2 )
 
C*        Close the master code and flag table files.
 
          CLOSE ( unit = lun1 )
          CLOSE ( unit = lun2 )
 
        ENDIF
 
        IF ( iprt .GE. 2 ) THEN
        CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++++++')
        CALL errwrt(' ')
        ENDIF
 
        RETURN
900     bort_str = 'BUFRLIB: IREADMT - COULD NOT OPEN STANDARD FILE:'
        CALL bort2(bort_str,stdfil)
901     bort_str = 'BUFRLIB: IREADMT - COULD NOT OPEN LOCAL FILE:'
        CALL bort2(bort_str,locfil)
        END