<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='UFBMEM'><A href='../../html_code/bufr/ufbmem.f.html#UFBMEM' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE UFBMEM(LUNIT,INEW,IRET,IUNIT) 1,22
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: UFBMEM
C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE OPENS A BUFR FILE FOR INPUT, READS EACH
C MESSAGE AND TRANSFERS THEM ONE-BY-ONE TO INTERNAL MEMORY (ARRAY
C MSGS IN COMMON BLOCK /MSGMEM/). IF MESSAGES ARE APPENDED TO
C EXISTING MESSAGES IN INTERNAL MEMORY, THE BUFR FILE READ HERE IS
C CLOSED PRIOR TO RETURNING TO THE CALLING PROGRAM.
C
C PROGRAM HISTORY LOG:
C 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
C 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C ROUTINE "BORT"
C 1999-11-18 J. WOOLLEN -- THE MAXIMUM NUMBER OF BYTES REQUIRED TO
C STORE ALL MESSAGES INTERNALLY WAS INCREASED
C FROM 4 MBYTES TO 8 MBYTES
C 2000-09-19 J. WOOLLEN -- MAXIMUM MESSAGE LENGTH INCREASED FROM
C 10,000 TO 20,000 BYTES
C 2001-08-15 D. KEYSER -- PARAMETER MAXMEM (THE MAXIMUM NUMBER OF
C BYTES REQUIRED TO STORE ALL MESSAGES
C INTERNALLY) WAS INCREASED FROM 8 MBYTES TO
C 16 MBYTES
C 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
C INTERDEPENDENCIES
C 2003-11-04 D. KEYSER -- PARAMETER MAXMSG (THE MAXIMUM NUMBER OF
C BUFR MESSAGES WHICH CAN BE STORED
C INTERNALLY) INCREASED FROM 50000 TO 200000;
C UNIFIED/PORTABLE FOR WRF; ADDED
C DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
C MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
C TERMINATES ABNORMALLY
C 2004-08-09 J. ATOR -- MAXIMUM MESSAGE LENGTH INCREASED FROM
C 20,000 TO 50,000 BYTES
C 2004-11-15 D. KEYSER -- MODIFIED TO NOT ABORT WHEN THERE ARE EITHER
C TOO MANY MESSAGES READ IN (I.E., .GT.
C MAXMSG) OR TOO MANY BYTES READ IN (I.E.,
C .GT. MAXMEM), BUT RATHER JUST STORE MAXMSG
C MESSAGES OR MAXMEM BYTES AND PRINT A
C DIAGNOSTIC; PARAMETER MAXMEM (THE MAXIMUM
C NUMBER OF BYTES REQUIRED TO STORE ALL
C MESSAGES INTERNALLY) WAS INCREASED FROM 16
C MBYTES TO 50 MBYTES
C 2005-11-29 J. ATOR -- USE RDMSGW AND NMWRD
C 2009-03-23 J. ATOR -- MODIFIED TO HANDLE EMBEDDED BUFR TABLE
C (DICTIONARY) MESSAGES
C 2012-09-15 J. WOOLLEN -- MODIFIED FOR C/I/O/BUFR INTERFACE;
C CALL STATUS TO GET LUN; REPLACE FORTRAN
C REWIND AND BACKSPACE WITH C ROUTINES CEWIND
C AND BACKBUFR
C
C USAGE: CALL UFBMEM
(LUNIT, INEW, IRET, IUNIT)
C INPUT ARGUMENT LIST:
C LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C INEW - INTEGER: SWITCH:
C 0 = initialize internal arrays prior to
C transferring messages here
C else = append the messages transferred here to
C internal memory arrays
C
C OUTPUT ARGUMENT LIST:
C IRET - INTEGER: NUMBER OF MESSAGES TRANSFERRED
C IUNIT - INTEGER: RETURN CODE:
C 0 = no messages were read from LUNIT, file is
C empty
C LUNIT = INEW input as 0
C else = FORTRAN logical unit for BUFR file
C associated with initial message transferred
C to internal memory
C
C INPUT FILES:
C UNIT "LUNIT" - BUFR FILE
C
C REMARKS:
C NOTE THAT IREADMM, RDMEMM, READMM, UFBMMS, UFBMNS, UFBRMS, UFBTAB
C OR UFBTAM CAN BE CALLED AFTER THIS TO READ SPECIFIC BUFR MESSAGES
C FROM INTERNAL MEMORY.
C
C THIS ROUTINE CALLS: BORT CLOSBF CPDXMM ERRWRT
C IDXMSG NMWRD OPENBF RDMSGW
C STATUS CEWIND BACKBUFR
C THIS ROUTINE IS CALLED BY: None
C Normally called only by application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /MSGMEM/ MUNIT,MLAST,MSGP(0:MAXMSG),MSGS(MAXMEM),
. MDX(MXDXW),IPDXM(MXDXM),LDXM,NDXM,LDXTS,NDXTS,
. IFDXTS(MXDXTS),ICDXTS(MXDXTS),IPMSGS(MXDXTS)
CHARACTER*128 BORT_STR,ERRSTR
DIMENSION MBAY(MXMSGLD4)
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C TRY TO OPEN BUFR FILE AND SET TO INITIALIZE OR CONCATENATE
C ----------------------------------------------------------
CALL OPENBF(LUNIT,'IN',LUNIT)
IF(INEW.EQ.0) THEN
MSGP(0) = 0
MUNIT = 0
MLAST = 0
NDXTS = 0
LDXTS = 0
NDXM = 0
LDXM = 0
ENDIF
NMSG = MSGP(0)
IRET = 0
IFLG = 0
ITIM = 0
C Copy any BUFR dictionary table messages from the beginning of
C LUNIT into COMMON /MSGMEM/ for possible later use. Note that
C such a table (if one exists) is already now in scope due to the
C prior call to subroutine OPENBF, which in turn would have
C automatically called subroutines READDX, RDBFDX and MAKESTAB
C for this table.
ITEMP = NDXTS
CALL STATUS(LUNIT,LUN,IL,IM)
CALL CEWIND(LUN)
CALL CPDXMM(LUNIT)
C If a table was indeed present at the beginning of the file,
C then set the flag to indicate that this table is now in scope.
IF ((ITEMP+1).EQ.NDXTS) LDXTS = NDXTS
C TRANSFER MESSAGES FROM FILE TO MEMORY - SET MESSAGE POINTERS
C ------------------------------------------------------------
1 CALL RDMSGW(LUNIT,MBAY,IER)
IF(IER.EQ.-1) GOTO 100
IF(IER.EQ.-2) GOTO 900
IF(IDXMSG(MBAY).EQ.1) THEN
C New "embedded" BUFR dictionary table messages have been found in
C this file. Copy them into COMMON /MSGMEM/ for later use.
call backbufr(lun) !BACKSPACE LUNIT
CALL CPDXMM(LUNIT)
GOTO 1
ENDIF
NMSG = NMSG+1
IF(NMSG .GT.MAXMSG) IFLG = 1
LMEM = NMWRD(MBAY)
IF(LMEM+MLAST.GT.MAXMEM) IFLG = 2
IF(IFLG.EQ.0) THEN
IRET = IRET+1
DO I=1,LMEM
MSGS(MLAST+I) = MBAY(I)
ENDDO
MSGP(0) = NMSG
MSGP(NMSG) = MLAST+1
ELSE
IF(ITIM.EQ.0) THEN
MLAST0 = MLAST
ITIM=1
ENDIF
ENDIF
MLAST = MLAST+LMEM
GOTO 1
C EXITS
C -----
100 IF(IFLG.EQ.1) THEN
C EMERGENCY ROOM TREATMENT FOR MAXMSG ARRAY OVERFLOW
C --------------------------------------------------
IF(IPRT.GE.0) THEN
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
WRITE ( UNIT=ERRSTR, FMT='(A,A,I8,A)' )
. 'BUFRLIB: UFBMEM - THE NO. OF MESSAGES REQUIRED TO STORE ',
. 'ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (', MAXMSG,
. ') - INCOMPLETE READ'
CALL ERRWRT(ERRSTR)
WRITE ( UNIT=ERRSTR, FMT='(A,I8,A,I8,A)' )
. '>>>UFBMEM STORED ', MSGP(0), ' MESSAGES OUT OF ', NMSG, '<<<'
CALL ERRWRT(ERRSTR)
WRITE ( UNIT=ERRSTR, FMT='(A,I8,A,I8,A)' )
. '>>>UFBMEM STORED ', MLAST0, ' BYTES OUT OF ', MLAST, '<<<'
CALL ERRWRT(ERRSTR)
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
CALL ERRWRT(' ')
ENDIF
MLAST=MLAST0
ENDIF
IF(IFLG.EQ.2) THEN
C EMERGENCY ROOM TREATMENT FOR MAXMEM ARRAY OVERFLOW
C --------------------------------------------------
IF(IPRT.GE.0) THEN
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
WRITE ( UNIT=ERRSTR, FMT='(A,A,I8,A)' )
. 'BUFRLIB: UFBMEM - THE NO. OF BYTES REQUIRED TO STORE ',
. 'ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (', MAXMEM,
. ') - INCOMPLETE READ'
CALL ERRWRT(ERRSTR)
WRITE ( UNIT=ERRSTR, FMT='(A,I8,A,I8,A)' )
. '>>>UFBMEM STORED ', MLAST0, ' BYTES OUT OF ', MLAST, '<<<'
CALL ERRWRT(ERRSTR)
WRITE ( UNIT=ERRSTR, FMT='(A,I8,A,I8,A)' )
. '>>>UFBMEM STORED ', MSGP(0), ' MESSAGES OUT OF ', NMSG, '<<<'
CALL ERRWRT(ERRSTR)
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
CALL ERRWRT(' ')
ENDIF
MLAST=MLAST0
ENDIF
IF(IRET.EQ.0) THEN
CALL CLOSBF(LUNIT)
ELSE
IF(MUNIT.NE.0) CALL CLOSBF(LUNIT)
IF(MUNIT.EQ.0) MUNIT = LUNIT
ENDIF
IUNIT = MUNIT
C EXITS
C -----
RETURN
900 WRITE(BORT_STR,'("BUFRLIB: UFBMEM - ERROR READING MESSAGE '//
. 'NUMBER",I5," INTO MEMORY FROM UNIT",I3)') NMSG+1,LUNIT
CALL BORT(BORT_STR)
END