cpyupd.f

Go to the documentation of this file.

C> @file
C> @brief Copy a BUFR data subset.
C> pointers.
C>
C> @author Woollen @date 1994-01-06
 
C> This subroutine copies a BUFR data subset from one unit
C> to another within internal memory and resets the pointers.
C> If the subset will not fit into the output message, or
C> if the subset byte count exceeds 65530 (sufficiently close to the
C> 16-bit byte counter upper limit of 65535), then that message is
C> flushed to lunit and a new one is created in order to hold the
C> copied subset. Any subset with byte count > 65530 will be written
C> into its own one-subset message. If the subset to be copied is
C> larger than the maximum message length, then a call is issued to
C> subroutine bort().
C>
C> @param[in] LUNIT - integer: Fortran logical unit number for BUFR file
C>                    associated with output unit.
C> @param[in] LIN - integer: I/O stream index into internal memory arrays
C>                  for input unit
C> @param[in] LUN - integer: I/O stream index into internal memory arrays
C>                  for output unit.
C> @param[in] IBYT - integer: length (in bytes) of data subset
C>
C> @author Woollen @date 1994-01-06
 
      SUBROUTINE cpyupd(LUNIT,LIN,LUN,IBYT)
 
      USE moda_msgcwd
      USE moda_bitbuf
 
      COMMON /msgptr/ nby0,nby1,nby2,nby3,nby4,nby5
 
      COMMON /quiet / iprt
 
      CHARACTER*128 BORT_STR, ERRSTR
 
      LOGICAL MSGFULL
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
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)) GOTO 900
 
C  TRANSFER SUBSET FROM ONE MESSAGE TO THE OTHER
C  ---------------------------------------------
 
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(mbay(1,lin),mbyt(lin)+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 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: CPYUPD - SUBSET HAS BYTE COUNT = ',ibyt,' > UPPER ',
     . 'LIMIT OF 65535'
      CALL errwrt(errstr)
      CALL errwrt('>>>>>>>WILL BE COPIED INTO ITS OWN MESSAGE<<<<<<<<')
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL errwrt(' ')
         ENDIF
         CALL msgwrt(lunit,mbay(1,lun),mbyt(lun))
         CALL msgini(lun)
      ENDIF
 
C  EXITS
C  -----
 
      RETURN
900   WRITE(bort_str,'("BUFRLIB: CPYUPD - THE LENGTH OF THIS SUBSET '//
     . 'EXCEEDS THE MAXIMUM MESSAGE LENGTH (",I6,")")') maxbyt
      CALL bort(bort_str)
      END