atrcpt.f

Go to the documentation of this file.

C> @file
C> @brief Add a tank receipt time to a BUFR message.
C> @author J. Ator @date 2009-03-23
 
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> 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> @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> @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> @author J. Ator @date 2009-03-23
 
        RECURSIVE SUBROUTINE atrcpt(MSGIN,LMSGOT,MSGOT)
 
        USE modv_im8b
 
        dimension msgin(*), msgot(*)
 
        COMMON /hrdwrd/ nbytw,nbitw,iord(8)
        COMMON /tnkrcp/ itryr,itrmo,itrdy,itrhr,itrmi,ctrt
 
        CHARACTER*1 ctrt
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C       Check for I8 integers.
 
        IF(im8b) THEN
           im8b=.false.
 
           CALL x84 ( lmsgot, my_lmsgot, 1 )
           CALL atrcpt ( msgin, my_lmsgot*2, msgot )
 
           im8b=.true.
           RETURN
        ENDIF
 
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