<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='MSGUPD'><A href='../../html_code/bufr/msgupd.f.html#MSGUPD' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE MSGUPD(LUNIT,LUN) 3,15
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: MSGUPD
C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE PACKS UP THE CURRENT SUBSET WITHIN MEMORY
C (ARRAY IBAY IN COMMON BLOCK /BITBUF/) AND THEN TRIES TO ADD IT TO
C THE BUFR MESSAGE THAT IS CURRENTLY OPEN WITHIN MEMORY FOR LUNIT
C (ARRAY MBAY IN COMMON BLOCK /BITBUF/). IF THE SUBSET WILL NOT FIT
C INTO THE CURRENTLY OPEN MESSAGE, THEN THAT MESSAGE IS FLUSHED TO
C LUNIT AND A NEW ONE IS CREATED IN ORDER TO HOLD THE CURRENT SUBSET.
C IF THE SUBSET IS LARGER THAN AN EMPTY MESSAGE, THE SUBSET IS
C DISCARDED AND A DIAGNOSTIC IS PRINTED.
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 1998-12-14 J. WOOLLEN -- NO LONGER CALLS BORT IF A SUBSET IS LARGER
C THAN A MESSAGE, JUST DISCARDS THE SUBSET
C 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
C OPENED AT ONE TIME INCREASED FROM 10 TO 32
C (NECESSARY IN ORDER TO PROCESS MULTIPLE
C BUFR FILES UNDER THE MPI)
C 2000-09-19 J. WOOLLEN -- MAXIMUM MESSAGE LENGTH INCREASED FROM
C 10,000 TO 20,000 BYTES
C 2003-11-04 J. ATOR -- ADDED DOCUMENTATION
C 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
C INTERDEPENDENCIES
C 2003-11-04 D. KEYSER -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
C DOCUMENTATION
C 2004-08-09 J. ATOR -- MAXIMUM MESSAGE LENGTH INCREASED FROM
C 20,000 TO 50,000 BYTES
C 2009-03-23 J. ATOR -- USE MSGFULL AND ERRWRT
C
C USAGE: CALL MSGUPD
(LUNIT, LUN)
C INPUT ARGUMENT LIST:
C LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C (ASSOCIATED WITH FILE CONNECTED TO LOGICAL UNIT LUNIT)
C
C REMARKS:
C THIS ROUTINE CALLS: ERRWRT IUPB MSGFULL MSGINI
C MSGWRT MVB PAD PKB
C USRTPL
C THIS ROUTINE IS CALLED BY: WRITSA WRITSB
C Normally not called by any application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /MSGPTR/ NBY0,NBY1,NBY2,NBY3,NBY4,NBY5
COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
. INODE(NFILES),IDATE(NFILES)
COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
. MBAY(MXMSGLD4,NFILES)
COMMON /QUIET / IPRT
LOGICAL MSGFULL
CHARACTER*128 ERRSTR
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C PAD THE SUBSET BUFFER
C ---------------------
CALL PAD(IBAY,IBIT,IBYT,8)
C SEE IF THE NEW SUBSET FITS
C --------------------------
IF(MSGFULL(MBYT(LUN),IBYT,MAXBYT)) THEN
c .... NO it does not fit
CALL MSGWRT(LUNIT,MBAY(1,LUN),MBYT(LUN))
CALL MSGINI(LUN)
ENDIF
IF(MSGFULL(MBYT(LUN),IBYT,MAXBYT)) GOTO 900
C SET A BYTE COUNT AND TRANSFER THE SUBSET BUFFER INTO THE MESSAGE
C ----------------------------------------------------------------
LBIT = 0
CALL PKB(IBYT,16,IBAY,LBIT)
C Note that we want to append the data for this subset to the end
C of Section 4, but the value in MBYT(LUN) already includes the
C length of Section 5 (i.e. 4 bytes). Therefore, we need to begin
C writing at the point 3 bytes prior to the byte currently pointed
C to by MBYT(LUN).
CALL MVB(IBAY,1,MBAY(1,LUN),MBYT(LUN)-3,IBYT)
C UPDATE THE SUBSET AND BYTE COUNTERS
C --------------------------------------
MBYT(LUN) = MBYT(LUN) + IBYT
NSUB(LUN) = NSUB(LUN) + 1
LBIT = (NBY0+NBY1+NBY2+4)*8
CALL PKB(NSUB(LUN),16,MBAY(1,LUN),LBIT)
LBYT = NBY0+NBY1+NBY2+NBY3
NBYT = IUPB(MBAY(1,LUN),LBYT+1,24)
LBIT = LBYT*8
CALL PKB(NBYT+IBYT,24,MBAY(1,LUN),LBIT)
C RESET THE USER ARRAYS AND EXIT NORMALLY
C ---------------------------------------
CALL USRTPL(LUN,1,1)
GOTO 100
C ON ENCOUTERING OVERLARGE SUBSETS, EXIT GRACEFULLY (SUBSET DISCARDED)
C --------------------------------------------------------------------
900 IF(IPRT.GE.0) THEN
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
WRITE ( UNIT=ERRSTR, FMT='(A,A,I7,A)')
. 'BUFRLIB: MSGUPD - SUBSET LONGER THAN ANY POSSIBLE MESSAGE ',
. '{MAXIMUM MESSAGE LENGTH = ', MAXBYT, '}'
CALL ERRWRT(ERRSTR)
CALL ERRWRT('>>>>>>>OVERLARGE SUBSET DISCARDED FROM FILE<<<<<<<<')
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
CALL ERRWRT(' ')
ENDIF
C EXIT
C ----
100 RETURN
END