atrcpt.f

Go to the documentation of this file.

C> @file
C> @brief Add a tank receipt time to a BUFR message.
 
C> This subroutine reads an input message and outputs an equivalent
C> BUFR message with a tank receipt time added to Section 1.
C>
C> <p>The tank receipt time to be added must have been specified via
C> a previous call to subroutine strcpt().  This subroutine performs
C> the same function as subroutine strcpt() when the latter is called
C> with CF = 'Y', except that the latter subroutine operates on BUFR
C> messages internally within the software, whereas this subroutine
C> operates on a single BUFR message passed in via a memory array.
C>
C> @author J. Ator
C> @date 2009-03-23
C>
C> @param[in] MSGIN   -- integer(*): BUFR message
C> @param[in] LMSGOT  -- integer: Dimensioned size (in integers) of
C>                       MSGOT; used by the subroutine to ensure that
C>                       it doesn't overflow the MSGOT array
C> @param[out] MSGOT  -- integer(*): Copy of MSGIN with a tank
C>                       receipt time added to Section 1
C>
C> @remarks
C> - MSGIN and MSGOT must be separate arrays.
C> - MSGOT will be longer in length than MSGIN, so the user must allow
C> for extra space when allocating MSGOT within the application program.
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2009-03-23 | J. Ator  | Original author |
C>
    SUBROUTINE atrcpt(MSGIN,LMSGOT,MSGOT)
 
    dimension msgin(*), msgot(*)
 
    COMMON /hrdwrd/ nbytw,nbitw,iord(8)
    COMMON /tnkrcp/ itryr,itrmo,itrdy,itrhr,itrmi,ctrt
 
    CHARACTER*1 CTRT
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C   Get some section lengths and addresses from the input message.
 
    CALL getlens(msgin,1,len0,len1,l2,l3,l4,l5)
 
    iad1 = len0
    iad2 = iad1 + len1
 
    lenm = iupbs01(msgin,'LENM')
 
C   Check for overflow of the output array.  Note that the new
C   message will be 6 bytes longer than the input message.
 
    lenmot = lenm + 6
    IF(lenmot.GT.(lmsgot*nbytw)) GOTO 900 
 
    len1ot = len1 + 6
 
C   Write Section 0 of the new message into the output array.
 
    CALL mvb ( msgin, 1, msgot, 1, 4 )
    ibit = 32
    CALL pkb ( lenmot, 24, msgot, ibit )
    CALL mvb ( msgin, 8, msgot, 8, 1 )
 
C   Store the length of the new Section 1.
 
    ibit = iad1*8
    CALL pkb ( len1ot, 24, msgot, ibit )
 
C   Copy the remainder of Section 1 from the input array to the
C   output array.
 
    CALL mvb ( msgin, iad1+4, msgot, (ibit/8)+1, len1-3 )
 
C   Append the tank receipt time data to the new Section 1.
 
    ibit = iad2*8
    CALL pkb ( itryr, 16, msgot, ibit )
    CALL pkb ( itrmo,  8, msgot, ibit )
    CALL pkb ( itrdy,  8, msgot, ibit )
    CALL pkb ( itrhr,  8, msgot, ibit )
    CALL pkb ( itrmi,  8, msgot, ibit )
    
C   Copy Sections 2, 3, 4 and 5 from the input array to the
C   output array.
 
    CALL mvb ( msgin, iad2+1, msgot, (ibit/8)+1, lenm-iad2 )
 
    RETURN
900 CALL bort('BUFRLIB: ATRCPT - OVERFLOW OF OUTPUT MESSAGE '//
     .    'ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY')
    END