<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='CPDXMM'><A href='../../html_code/bufr/cpdxmm.f.html#CPDXMM' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE CPDXMM( LUNIT ) 3,12
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: CPDXMM
C PRGMMR: J. ATOR ORG: NP12 DATE: 2009-03-23
C
C ABSTRACT: BEGINNING AT THE CURRENT FILE POINTER LOCATION WITHIN LUNIT,
C THIS SUBROUTINE READS A COMPLETE DICTIONARY TABLE (I.E. ONE OR MORE
C ADJACENT BUFR DX (DICTIONARY) MESSAGES) INTO COMMON /MSGMEM/.
C
C PROGRAM HISTORY LOG:
C 2009-03-23 J. ATOR -- ORIGINAL AUTHOR
C 2012-09-15 J. WOOLLEN -- MODIFIED FOR C/I/O/BUFR INTERFACE;
C REPLACED FORTRAN BACKSPACE WITH C BACKBUFR
C
C USAGE: CALL CPDXMM
(LUNIT)
C INPUT ARGUMENT LIST:
C LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C
C REMARKS:
C
C THE FOLLOWING VALUES ARE STORED WITHIN COMMON /MSGMEM/ BY THIS
C SUBROUTINE:
C
C LDXM = number of array words filled within MDX
C
C MDX(I=1,LDXM) = DX dictionary messages for use in decoding
C data messages stored within MSGS array (in
C COMMON /MSGMEM/)
C
C NDXM = number of DX dictionary messages within MDX
C
C IPDXM(I=1,NDXM) = pointer to first word of (I)th message
C within MDX
C
C NDXTS = number of DX dictionary tables represented by
C messages within MDX
C
C IFDXTS(J=1,NDXTS) = sequential number of first message
C within MDX which is part of (J)th
C dictionary table
C
C ICDXTS(J=1,NDXTS) = count of consecutive messages within MDX
C (beginning with IFDXTS(J)) which
C constitute (J)th dictionary table
C
C IPMSGS(J=1,NDXTS) = sequential number of first data message
C within MSGS array (in COMMON /MSGMEM/)
C to which (J)th dictionary table applies
C
C LDXTS = current dictionary table that is in scope
C (i.e. a number between 1 and NDXTS)
C
C THIS ROUTINE CALLS: BORT ERRWRT IDXMSG IUPBS3
C NMWRD RDMSGW
C THIS ROUTINE IS CALLED BY: UFBMEM
C Not normally called by application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /QUIET/ IPRT
COMMON /MSGMEM/ MUNIT,MLAST,MSGP(0:MAXMSG),MSGS(MAXMEM),
. MDX(MXDXW),IPDXM(MXDXM),LDXM,NDXM,LDXTS,NDXTS,
. IFDXTS(MXDXTS),ICDXTS(MXDXTS),IPMSGS(MXDXTS)
DIMENSION MBAY(MXMSGLD4)
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, MBAY, 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(lun)
DONE = .TRUE.
ELSE IF ( IER .EQ. -2 ) THEN
GOTO 901
ELSE IF ( IDXMSG(MBAY) .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(lun)
DONE = .TRUE.
ELSE IF ( IUPBS3(MBAY,'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 COMMON /MSGMEM/.
ICT = ICT + 1
IF ( ( NDXM + ICT ) .GT. MXDXM ) GOTO 902
IPDXM(NDXM+ICT) = LDXM + 1
LMEM = NMWRD(MBAY)
IF ( ( LDXM + LMEM ) .GT. MXDXW ) GOTO 903
DO J = 1, LMEM
MDX(LDXM+J) = MBAY(J)
ENDDO
LDXM = LDXM + LMEM
ENDIF
ENDDO
C Update the table information within COMMON /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