NCEPLIBS-bufr  11.5.0
 All Data Structures Files Functions Variables Pages
atrcpt.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Add a tank receipt time to a BUFR message.
3 
4 C> This subroutine reads an input message and outputs an equivalent
5 C> BUFR message with a tank receipt time added to Section 1.
6 C>
7 C> <p>The tank receipt time to be added must have been specified via
8 C> a previous call to subroutine strcpt(). This subroutine performs
9 C> the same function as subroutine strcpt() when the latter is called
10 C> with CF = 'Y', except that the latter subroutine operates on BUFR
11 C> messages internally within the software, whereas this subroutine
12 C> operates on a single BUFR message passed in via a memory array.
13 C>
14 C> @author J. Ator
15 C> @date 2009-03-23
16 C>
17 C> @param[in] MSGIN - integer(*): BUFR message
18 C> @param[in] LMSGOT - integer: Dimensioned size (in integers) of
19 C> MSGOT; used by the subroutine to ensure that
20 C> it doesn't overflow the MSGOT array
21 C> @param[out] MSGOT - integer(*): Copy of MSGIN with a tank
22 C> receipt time added to Section 1
23 C>
24 C> @remarks
25 C> - MSGIN and MSGOT must be separate arrays.
26 C> - MSGOT will be longer in length than MSGIN, so the user must allow
27 C> for extra space when allocating MSGOT within the application program.
28 C>
29 C> <b>Program history log:</b>
30 C> - 2009-03-23 J. Ator -- Original author
31 C>
32  SUBROUTINE atrcpt(MSGIN,LMSGOT,MSGOT)
33 
34  dimension msgin(*), msgot(*)
35 
36  COMMON /hrdwrd/ nbytw,nbitw,iord(8)
37  COMMON /tnkrcp/ itryr,itrmo,itrdy,itrhr,itrmi,ctrt
38 
39  CHARACTER*1 ctrt
40 
41 C-----------------------------------------------------------------------
42 C-----------------------------------------------------------------------
43 
44 C Get some section lengths and addresses from the input message.
45 
46  CALL getlens(msgin,1,len0,len1,l2,l3,l4,l5)
47 
48  iad1 = len0
49  iad2 = iad1 + len1
50 
51  lenm = iupbs01(msgin,'LENM')
52 
53 C Check for overflow of the output array. Note that the new
54 C message will be 6 bytes longer than the input message.
55 
56  lenmot = lenm + 6
57  IF(lenmot.GT.(lmsgot*nbytw)) goto 900
58 
59  len1ot = len1 + 6
60 
61 C Write Section 0 of the new message into the output array.
62 
63  CALL mvb( msgin, 1, msgot, 1, 4 )
64  ibit = 32
65  CALL pkb( lenmot, 24, msgot, ibit )
66  CALL mvb( msgin, 8, msgot, 8, 1 )
67 
68 C Store the length of the new Section 1.
69 
70  ibit = iad1*8
71  CALL pkb( len1ot, 24, msgot, ibit )
72 
73 C Copy the remainder of Section 1 from the input array to the
74 C output array.
75 
76  CALL mvb( msgin, iad1+4, msgot, (ibit/8)+1, len1-3 )
77 
78 C Append the tank receipt time data to the new Section 1.
79 
80  ibit = iad2*8
81  CALL pkb( itryr, 16, msgot, ibit )
82  CALL pkb( itrmo, 8, msgot, ibit )
83  CALL pkb( itrdy, 8, msgot, ibit )
84  CALL pkb( itrhr, 8, msgot, ibit )
85  CALL pkb( itrmi, 8, msgot, ibit )
86 
87 C Copy Sections 2, 3, 4 and 5 from the input array to the
88 C output array.
89 
90  CALL mvb( msgin, iad2+1, msgot, (ibit/8)+1, lenm-iad2 )
91 
92  RETURN
93 900 CALL bort('BUFRLIB: ATRCPT - OVERFLOW OF OUTPUT MESSAGE '//
94  . 'ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY')
95  END
subroutine mvb(IB1, NB1, IB2, NB2, NBM)
THIS SUBROUTINE COPIES A SPECIFIED NUMBER OF BYTES FROM ONE PACKED BINARY ARRAY TO ANOTHER...
Definition: mvb.f:43
subroutine getlens(MBAY, LL, LEN0, LEN1, LEN2, LEN3, LEN4, LEN5)
This subroutine reads the lengths of all of the individual sections of a given BUFR message...
Definition: getlens.f:37
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:23
subroutine pkb(NVAL, NBITS, IBAY, IBIT)
This subroutine encodes an integer value within a specified number of bits of an integer array...
Definition: pkb.f:40
subroutine atrcpt(MSGIN, LMSGOT, MSGOT)
This subroutine reads an input message and outputs an equivalent BUFR message with a tank receipt tim...
Definition: atrcpt.f:32
function iupbs01(MBAY, S01MNEM)
This function returns a specified value from within Section 0 or Section 1 of a BUFR message...
Definition: iupbs01.f:72