rdbfdx.f

Go to the documentation of this file.

C> @file
C> @brief Read a complete DX BUFR table.
C>
C> @author Woollen @date 1994-01-06
 
C> Beginning at the current file pointer location within LUNIT,
C> this subroutine reads a complete DX BUFR table into internal memory arrays
C> in module @ref moda_tababd. A DX BUFR table consists of one or more consecutive
C> DX BUFR messages.
C>
C> This subroutine performs a function similar to
C> rdusdx(), except that rdusdx() reads from a file containing
C> a user-supplied DX BUFR table in character format. See rdusdx()
C> for a description of the arrays that are filled
C> in module @ref moda_tababd.
C>
C> This subroutine performs a function similar to
C> cpdxmm(), except that cpdxmm() writes to the internal memory
C> arrays in module @ref moda_msgmem, for use with a file of BUFR messages that
C> is being read and stored into internal memory via subroutine ufbmem().
C>
C> @param[in] LUNIT - integer: fortran logical unit number for BUFR file.
C> @param[in] LUN - integer: I/O stream index into internal memory arrays.
C> (associated with file connected to logical unit LUNIT).
C>
C> @author Woollen @date 1994-01-06
      SUBROUTINE rdbfdx(LUNIT,LUN)
 
        use bufrlib
 
        USE moda_mgwa
 
        COMMON /quiet/  iprt
 
        CHARACTER*128 ERRSTR
 
        LOGICAL DONE
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
        CALL dxinit(lun,0)
 
        ict = 0
        done = .false.
 
C       Read a complete dictionary table from LUNIT, as a set of one or
C       more DX dictionary messages.
 
        DO WHILE ( .NOT. done )
          CALL rdmsgw ( lunit, mgwa, ier )
          IF ( ier .EQ. -1 ) THEN
 
C           Don't abort for an end-of-file condition, since it may be
C           possible for a file to end with dictionary messages.
C           Instead, backspace the file pointer and let the calling
C           routine diagnose the end-of-file condition and deal with
C           it as it sees fit.
 
            CALL backbufr_c(lun)
            done = .true.
          ELSE IF ( ier .EQ. -2 ) THEN
            GOTO 900
          ELSE IF ( idxmsg(mgwa) .NE. 1 ) THEN
 
C           This is a non-DX dictionary message.  Assume we've reached
C           the end of the dictionary table, and backspace LUNIT so that
C           the next read (e.g. in the calling routine) will get this
C           same message.
 
            CALL backbufr_c(lun)
            done = .true.
          ELSE IF ( iupbs3(mgwa,'NSUB') .EQ. 0 ) THEN
 
C           This is a DX dictionary message, but it doesn't contain any
C           actual dictionary information.  Assume we've reached the end
C           of the dictionary table.
 
            done = .true.
          ELSE
 
C           Store this message into MODULE TABABD.
 
            ict = ict + 1
            CALL stbfdx(lun,mgwa)
          ENDIF
        ENDDO
 
        IF ( iprt .GE. 2 ) THEN
        CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++++++')
        WRITE ( unit=errstr, fmt='(A,I3,A)' )
     .    'BUFRLIB: RDBFDX - STORED NEW DX TABLE CONSISTING OF (',
     .    ict, ') MESSAGES;'
        CALL errwrt(errstr)
        errstr = 'WILL APPLY THIS TABLE TO ALL SUBSEQUENT DATA IN '//
     .    'FILE UNTIL NEXT DX TABLE IS FOUND'
        CALL errwrt(errstr)
        CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++++++')
        CALL errwrt(' ')
        ENDIF
 
        CALL makestab
 
        RETURN
 900    CALL bort('BUFRLIB: RDBFDX - ERROR READING A BUFR DICTIONARY '//
     .    'MESSAGE')
        END