<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='ATRCPT'><A href='../../html_code/bufr/atrcpt.f.html#ATRCPT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE ATRCPT(MSGIN,LMSGOT,MSGOT) 2,15
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: ATRCPT
C PRGMMR: ATOR ORG: NP12 DATE: 2009-03-23
C
C ABSTRACT: THIS SUBROUTINE READS AN INPUT BUFR MESSAGE, APPENDS THE
C TANK RECEIPT TIME TO SECTION 1, AND WRITES THE RESULT TO A NEW BUFR
C MESSAGE FOR OUTPUT. THE TANK RECEIPT TIME MUST HAVE BEEN SPECIFIED
C VIA A PREVIOUS CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE STRCPT. THE
C OUTPUT MESSAGE WILL BE SLIGHTLY LONGER THAN THE INPUT MESSAGE, SO
C THE USER MUST ALLOW FOR ENOUGH SPACE WITHIN THE OUTPUT ARRAY.
C
C PROGRAM HISTORY LOG:
C 2009-03-23 J. ATOR -- ORIGINAL AUTHOR
C
C USAGE: CALL ATRCPT
(MSGIN, LMSGOT, MSGOT)
C INPUT ARGUMENT LIST:
C MSGIN - INTEGER: *-WORD ARRAY CONTAINING BUFR MESSAGE
C LMSGOT - INTEGER: DIMENSIONED SIZE (IN INTEGER WORDS) OF MSGOT;
C USED BY THE SUBROUTINE TO ENSURE THAT IT DOES NOT
C OVERFLOW THE MSGOT ARRAY
C
C OUTPUT ARGUMENT LIST:
C MSGOT - INTEGER: *-WORD ARRAY CONTAINING INPUT BUFR MESSAGE
C WITH TANK RECEIPT TIME APPENDED TO SECTION 1
C
C REMARKS:
C MSGIN AND MSGOT MUST BE SEPARATE ARRAYS.
C
C THIS ROUTINE CALLS: BORT GETLENS IUPBS01 MVB
C PKB
C THIS ROUTINE IS CALLED BY: MSGWRT
C Also called by application programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
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