reads3.f

Go to the documentation of this file.

C> @file
C> @brief Read the Section 3 descriptors from a BUFR message.
C>
C> @author J. Ator @date 2009-03-23
 
C> This subroutine reads the Section 3 descriptors from the
C> BUFR message in mbay(1,lun). It then uses the BUFR master tables
C> to generate the necessary information for these descriptors within
C> the internal BUFR table arrays.
C>
C> @param[in] LUN - integer: I/O stream index into internal memory arrays.
C>
C> @author J. Ator @date 2009-03-23
        SUBROUTINE reads3 ( LUN )
 
        use bufrlib
        USE moda_sc3bfr
        USE moda_bitbuf
        USE moda_dscach
 
        COMMON /quiet/  iprt
 
        dimension       ids3(maxnc)
        CHARACTER*6     CDS3(MAXNC),NUMB,ADN30
 
        CHARACTER*55    CSEQ
 
        CHARACTER*128   ERRSTR
 
        LOGICAL         INCACH
 
        SAVE    irepct
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C*      Check whether the appropriate BUFR master table information has
C*      already been read into internal memory for this message.
 
        IF ( ireadmt( lun ) .EQ. 1 ) THEN
 
C*        NO (i.e. we just had to read in new master table information
C*        for this message), so reset some corresponding values in
C*        other parts of the library.
 
          CALL dxinit ( lun, 0 )
          itmp = igettdi( 0 )
          irepct = 0
          ncnem = 0
        ENDIF
 
C*      Unpack the list of Section 3 descriptors from the message.
 
        CALL upds3 ( mbay(1,lun), maxnc, cds3, ncds3 )
        DO ii = 1, ncds3
          ids3(ii) = ifxy( cds3(ii) )
        ENDDO
 
C*      Is the list of Section 3 descriptors already in the cache?
 
C*      The cache is a performance-enhancing device which saves
C*      time when the same descriptor sequences are encountered
C*      over and over within the calling program.  Time is saved
C*      because the below calls to subroutines STSEQ and MAKESTAB
C*      are bypassed whenever a list is already in the cache.
 
        incach = .false.
        IF ( ncnem .GT. 0 ) THEN
          ii = 1
          DO WHILE ( (.NOT.incach) .AND. (ii.LE.ncnem) )
            IF ( ncds3 .EQ. ndc(ii) ) THEN
              jj = 1
              incach = .true.
              DO WHILE ( (incach) .AND. (jj.LE.ncds3) )
                IF ( ids3(jj) .EQ. idcach(ii,jj) ) THEN
                  jj = jj + 1
                ELSE
                  incach = .false.
                ENDIF
              ENDDO
              IF (incach) THEN
 
C*              The list is already in the cache, so store the
C*              corresponding Table A mnemonic into MODULE SC3BFR
C*              and return.
 
                IF ( iprt .GE. 2 ) THEN
        CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++++++')
        errstr = 'BUFRLIB: READS3 - RE-USED CACHE LIST FOR ' // cnem(ii)
        CALL errwrt(errstr)
        CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++++++')
        CALL errwrt(' ')
                ENDIF
                tamnem(lun) = cnem(ii)
                RETURN
              ENDIF
            ENDIF
            ii = ii + 1
          ENDDO
        ENDIF
 
C*      Get the next available index within the internal Table A.
 
        n = igetntbi( lun, 'A' )
 
C*      Generate a Table A mnemonic and sequence description.
 
        WRITE ( tamnem(lun), '(A5,I3.3)') 'MSTTB', n
        cseq = 'TABLE A MNEMONIC ' // tamnem(lun)
 
C*      Store the Table A mnemonic and sequence into the cache.
 
        ncnem = ncnem + 1
        IF ( ncnem .GT. mxcnem ) GOTO 900
        cnem(ncnem) = tamnem(lun)
        ndc(ncnem) = ncds3
        DO jj = 1, ncds3
          idcach(ncnem,jj) = ids3(jj)
        ENDDO
        IF ( iprt .GE. 2 ) THEN
        CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++++++')
        errstr = 'BUFRLIB: READS3 - STORED CACHE LIST FOR ' //
     .    cnem(ncnem)
        CALL errwrt(errstr)
        CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++++++')
        CALL errwrt(' ')
        ENDIF
 
C*      Get an FXY value to use with this Table A mnemonic.
 
        idn = igettdi( lun )
        numb = adn30( idn, 6 )
 
C*      Store all of the information for this mnemonic within the
C*      internal Table A.
 
        CALL stntbia ( n, lun, numb, tamnem(lun), cseq )
 
C*      Store all of the information for this sequence within the
C*      internal Tables B and D.
 
        CALL stseq_c ( lun, irepct, idn, tamnem(lun), cseq, ids3,
     .                 ncds3 )
 
C*      Update the jump/link table.
 
        CALL makestab
 
        RETURN
900     CALL bort('BUFRLIB: READS3 - MXCNEM OVERFLOW')
        END