cpdxmm.f

Go to the documentation of this file.

C> @file
C> Read embedded DX BUFR table into internal arrays.
C>
C> @author J. Ator @date 2009-03-23
 
C> This subroutine reads an entire DX BUFR table from a specified
C> file into internal arrays.
C>
C> @param[in] LUNIT   -- integer: Fortran logical unit number for BUFR
C>                       file
C>
C> @author J. Ator @date 2009-03-23
        SUBROUTINE cpdxmm( LUNIT )
 
        use bufrlib
 
        USE modv_mxdxts
 
        USE moda_mgwa
        USE moda_msgmem
 
        COMMON /quiet/  iprt
 
        CHARACTER*128   ERRSTR
 
        LOGICAL DONE
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
        IF ( ndxts .GE. mxdxts ) GOTO 900
 
        ict = 0
        done = .false.
        CALL status(lunit,lun,il,im)
 
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 901
          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 MSGMEM.
 
            ict = ict + 1
            IF ( ( ndxm + ict ) .GT. mxdxm ) GOTO 902
            ipdxm(ndxm+ict) = ldxm + 1
            lmem = nmwrd(mgwa)
            IF ( ( ldxm + lmem ) .GT. mxdxw ) GOTO 903
            DO j = 1, lmem
              mdx(ldxm+j) = mgwa(j)
            ENDDO
            ldxm = ldxm + lmem
          ENDIF
        ENDDO
 
C       Update the table information within MODULE MSGMEM.
 
        IF ( ict .GT. 0 ) THEN
          ifdxts(ndxts+1) = ndxm + 1
          icdxts(ndxts+1) = ict
          ipmsgs(ndxts+1) = msgp(0) + 1
          ndxm = ndxm + ict
          ndxts = ndxts + 1
          IF ( iprt .GE. 2 ) THEN
            CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++')
            WRITE ( unit=errstr, fmt='(A,I3,A,I3,A)')
     .          'BUFRLIB: CPDXMM - STORED NEW DX TABLE #', ndxts,
     .          ' CONSISTING OF ', ict, ' MESSAGES'
            CALL errwrt(errstr)
            CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++')
            CALL errwrt(' ')
          ENDIF
        ENDIF
 
        RETURN
 900    CALL bort('BUFRLIB: CPDXMM - MXDXTS OVERFLOW')
 901    CALL bort('BUFRLIB: CPDXMM - UNEXPECTED READ ERROR')
 902    CALL bort('BUFRLIB: CPDXMM - MXDXM OVERFLOW')
 903    CALL bort('BUFRLIB: CPDXMM - MXDXW OVERFLOW')
        END