SUBROUTINE UFBMEM(LUNIT,INEW,IRET,IUNIT)
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
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 NMWRD OPENBF
C RDMSGW
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)
CHARACTER*128 BORT_STR
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
ENDIF
NMSG = MSGP(0)
IRET = 0
IFLG = 0
ITIM = 0
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
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
PRINT*
PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
PRINT*,'BUFRLIB: UFBMEM - THE NO. OF MESSAGES REQUIRED TO STORE',
. ' ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (',MAXMSG,') - ',
. 'INCOMPLETE READ'
PRINT*,'>>>UFBMEM STORED ',MSGP(0),' MESSAGES OUT OF ',NMSG,'<<<'
PRINT*,'>>>UFBMEM STORED ',MLAST0,' BYTES OUT OF ',MLAST,'<<<'
PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
PRINT*
ENDIF
MLAST=MLAST0
ENDIF
IF(IFLG.EQ.2) THEN
C EMERGENCY ROOM TREATMENT FOR MAXMEM ARRAY OVERFLOW
C --------------------------------------------------
IF(IPRT.GE.0) THEN
PRINT*
PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
PRINT*,'BUFRLIB: UFBMEM - THE NO. OF BYTES REQUIRED TO STORE',
. ' ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (',MAXMEM,') - ',
. 'INCOMPLETE READ'
PRINT*,'>>>UFBMEM STORED ',MLAST0,' BYTES OUT OF ',MLAST,'<<<'
PRINT*,'>>>UFBMEM STORED ',MSGP(0),' MESSAGES OUT OF ',NMSG,'<<<'
PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
PRINT*
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