ireadmt.F

Go to the documentation of this file.

C> @file
C> @author ATOR @date 2009-03-23
    
C> THIS FUNCTION CHECKS THE MOST RECENT BUFR MESSAGE THAT
C>   WAS READ AS INPUT VIA SUBROUTINE READMG, READERME OR EQUIVALENT
C>   TO DETERMINE IF THE APPROPRIATE CORRESPONDING BUFR MASTER TABLES
C>   HAVE ALREADY BEEN READ INTO INTERNAL MEMORY.  IF NOT, THEN IT
C>   OPENS THE APPROPRIATE BUFR MASTER TABLE FILES AND READS THEM INTO
C>   INTERNAL MEMORY, CLEARING ANY PREVIOUS MASTER TABLE INFORMATION
C>   ALREADY STORED THERE.  INFORMATION ABOUT THE BUFR MASTER TABLE
C>   FILES IS OBTAINED FROM THE MOST RECENT CALL TO SUBROUTINE MTINFO,
C>   OR ELSE AS DEFINED WITHIN SUBROUTINE BFRINI IF SUBROUTINE MTINFO
C>   WAS NEVER CALLED.
C>
C> PROGRAM HISTORY LOG:
C> 2009-03-23  J. ATOR    -- ORIGINAL AUTHOR
C> 2014-11-25  J. ATOR    -- ADD CALL TO CPMSTABS FOR ACCESS TO MASTER
C>                           TABLE INFORMATION WITHIN C WHEN USING
C>                           DYNAMICALLY ALLOCATED ARRAYS
C> 2017-10-13  J. ATOR    -- ADD FUNCTIONALITY TO CHECK WHETHER NEW
C>                           MASTER TABLES NEED TO BE READ (THIS
C>                           FUNCTIONALITY WAS PREVIOUSLY PART OF
C>                           SUBROUTINE READS3)
C> 2018-04-09  J. ATOR    -- ONLY READ MASTER B AND D TABLES WHEN
C>                           SECTION 3 IS BEING USED FOR DECODING
C>
C> USAGE:    IREADMT ( LUN )
C>   INPUT ARGUMENT LIST:
C>     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C>
C>   OUTPUT ARGUMENT LIST:
C>    IREADMT   - INTEGER: RETURN CODE INDICATING WHETHER NEW BUFR
C>                MASTER TABLE FILES NEEDED TO BE OPENED AND READ
C>                DURING THIS CALL TO THE FUNCTION
C>                  0 = NO
C>                  1 = YES
C>
C>   INPUT FILES:
C>     UNITS 98,99  - IF SUBROUTINE MTINFO WAS NEVER CALLED, THEN THESE
C>                    LOGICAL UNIT NUMBERS ARE USED BY THIS ROUTINE FOR
C>                    OPENING AND READING THE BUFR MASTER TABLES.
C>                    ALTERNATIVELY, IF SUBROUTINE MTINFO WAS CALLED,
C>                    THEN THE LOGICAL UNIT NUMBERS SPECIFIED IN THE
C>                    MOST RECENT CALL TO MTINFO (ARGUMENTS LUNMT1 AND
C>                    LUNMT2) ARE USED INSTEAD.
C> REMARKS:
C>    THIS ROUTINE CALLS:        BORT2    CPMSTABS ERRWRT   ICVIDX
C>                               IFXY     ISTDESC  IUPBS01  MTFNAM
C>                               RDMTBB   RDMTBD   RDMTBF   UPDS3
C>    THIS ROUTINE IS CALLED BY: GETCFMNG READS3   UFDUMP
C>                               Normally not called by any application
C>                               programs.
C>
    INTEGER FUNCTION ireadmt ( LUN )

        USE modv_maxnc

    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 )

#ifdef DYNAMIC_ALLOCATION
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
    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