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> 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> <p>If not, then it opens the appropriate master BUFR tables on the
C> local file system and then reads the contents into internal
C> memory, clearing any previous master BUFR table information that
C> may have previously been stored there.
C>
C> @author J. Ator
C> @date 2009-03-23
C>
C> @param[in]  LUN     -- integer: Internal I/O stream index associated
C>                        with BUFR file
C> @returns ireadmt    -- integer: Flag indicating whether new master
C>                        BUFR tables needed to be read into internal
C>                        memory:
C>                        - 0 = No
C>                        - 1 = Yes
C>
C> <p>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> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2009-03-23 | J. Ator  | Original author |
C> | 2014-11-25 | J. Ator  | Add call to cpmstabs() for access to master table information within C when using dynamically-allocated arrays |
C> | 2017-10-13 | J. Ator  | Add functionality to check whether new master tables need to be read (this functionality was previously part of subroutine reads3()) |
C> | 2018-04-09 | J. Ator  | Only read master B and D tables when Section 3 is being used for decoding |
C>
    INTEGER FUNCTION ireadmt ( LUN )
 
        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( 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 ( 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