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