msgupd.f

Go to the documentation of this file.

C> @file
C> @brief Write an uncompressed BUFR data subset.
C>
C> @author Woollen @date 1994-01-06
 
C> This subroutine packs up the current subset within memory
C> (array ibay in module @ref moda_bitbuf) and then tries to add it to
C> the BUFR message that is currently open within memory for LUNIT
C> (array mbay in module @ref moda_bitbuf). If the subset will not fit
C> into the currently open message, or if the subset byte count exceeds
C> 65530 (sufficiently close to the 16-bit byte counter upper limit of
C> 65535), then that message is flushed to LUNIT and a new one is
C> created in order to hold the current subset. Any subset with byte
C> count > 65530 will be written into its own one-subset message.
C> if the current subset is larger than the maximum message length,
C> then the subset is discarded and a diagnostic is printed.
C>
C> @param[in] LUNIT - integer: fortran logical unit number for BUFR file.
C> @param[in] LUN - integer: I/O stream index into internal memory arrays
C> (associated with file connected to logical unit LUNIT).
C>
C> @author Woollen @date 1994-01-06
      SUBROUTINE msgupd(LUNIT,LUN)
 
      USE moda_msgcwd
      USE moda_bitbuf
      USE moda_h4wlc
 
      COMMON /msgptr/ nby0,nby1,nby2,nby3,nby4,nby5
      COMMON /quiet / iprt
 
      LOGICAL MSGFULL
 
      CHARACTER*128 ERRSTR
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  PAD THE SUBSET BUFFER
C  ---------------------
 
      CALL pad(ibay,ibit,ibyt,8)
 
C  CHECK WHETHER THE NEW SUBSET SHOULD BE WRITTEN INTO THE CURRENTLY
C  OPEN MESSAGE
C  -----------------------------------------------------------------
 
      IF(msgfull(mbyt(lun),ibyt,maxbyt)
     .      .OR.
     .  ((ibyt.GT.65530).AND.(nsub(lun).GT.0))) THEN
c       NO it should not, either because:
c        1) it doesn't fit,
c                -- OR --
c        2) it has byte count > 65530 (sufficiently close to the
c           upper limit for the 16 bit byte counter placed at the
c           beginning of each subset), AND the current message has
c           at least one subset in it,
c       SO write the current message out and create a new one to
c       hold the current subset
         CALL msgwrt(lunit,mbay(1,lun),mbyt(lun))
         CALL msgini(lun)
      ENDIF
 
      IF(msgfull(mbyt(lun),ibyt,maxbyt)) THEN
c       This is an overlarge subset that won't fit in any message
c       given the current value of MAXBYT, so discard the subset
c       and exit gracefully.
        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
        GOTO 100
      ENDIF
 
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  IF ANY LONG CHARACTER STRINGS ARE BEING HELD INTERNALLY FOR STORAGE
C  INTO THIS SUBSET, STORE THEM NOW.
C  -------------------------------------------------------------------
 
      IF(nh4wlc.GT.0) THEN
        DO ii = 1, nh4wlc
          CALL writlc(luh4wlc(ii),chh4wlc(ii),sth4wlc(ii))
        ENDDO
        nh4wlc = 0
      ENDIF
 
C  IF THE SUBSET BYTE COUNT IS > 65530, THEN GIVE IT ITS OWN ONE-SUBSET
C  MESSAGE (CANNOT HAVE ANY OTHER SUBSETS IN THIS MESSAGE BECAUSE THEIR
C  BEGINNING WOULD BE BEYOND THE UPPER LIMIT OF 65535 IN THE 16-BIT
C  BYTE COUNTER, MEANING THEY COULD NOT BE LOCATED!)
C  --------------------------------------------------------------------
 
      IF(ibyt.GT.65530) THEN
         IF(iprt.GE.1) THEN
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      WRITE ( unit=errstr, fmt='(A,I7,A,A)')
     . 'BUFRLIB: MSGUPD - SUBSET HAS BYTE COUNT = ',ibyt,' > UPPER ',
     . 'LIMIT OF 65535'
      CALL errwrt(errstr)
      CALL errwrt('>>>>>>>WILL BE WRITTEN INTO ITS OWN MESSAGE<<<<<<<<')
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL errwrt(' ')
         ENDIF
         CALL msgwrt(lunit,mbay(1,lun),mbyt(lun))
         CALL msgini(lun)
      ENDIF
 
C  RESET THE USER ARRAYS AND EXIT NORMALLY
C  ---------------------------------------
 
100   CALL usrtpl(lun,1,1)
 
C  EXIT
C  ----
 
      RETURN
      END