NCEPLIBS-bufr  11.6.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> | Date | Programmer | Comments |
31 C> | -----|------------|----------|
32 C> | 2009-03-23 | J. Ator | Original author |
33 C>
34  SUBROUTINE atrcpt(MSGIN,LMSGOT,MSGOT)
35 
36  dimension msgin(*), msgot(*)
37 
38  COMMON /hrdwrd/ nbytw,nbitw,iord(8)
39  COMMON /tnkrcp/ itryr,itrmo,itrdy,itrhr,itrmi,ctrt
40 
41  CHARACTER*1 ctrt
42 
43 C-----------------------------------------------------------------------
44 C-----------------------------------------------------------------------
45 
46 C Get some section lengths and addresses from the input message.
47 
48  CALL getlens(msgin,1,len0,len1,l2,l3,l4,l5)
49 
50  iad1 = len0
51  iad2 = iad1 + len1
52 
53  lenm = iupbs01(msgin,'LENM')
54 
55 C Check for overflow of the output array. Note that the new
56 C message will be 6 bytes longer than the input message.
57 
58  lenmot = lenm + 6
59  IF(lenmot.GT.(lmsgot*nbytw)) goto 900
60 
61  len1ot = len1 + 6
62 
63 C Write Section 0 of the new message into the output array.
64 
65  CALL mvb( msgin, 1, msgot, 1, 4 )
66  ibit = 32
67  CALL pkb( lenmot, 24, msgot, ibit )
68  CALL mvb( msgin, 8, msgot, 8, 1 )
69 
70 C Store the length of the new Section 1.
71 
72  ibit = iad1*8
73  CALL pkb( len1ot, 24, msgot, ibit )
74 
75 C Copy the remainder of Section 1 from the input array to the
76 C output array.
77 
78  CALL mvb( msgin, iad1+4, msgot, (ibit/8)+1, len1-3 )
79 
80 C Append the tank receipt time data to the new Section 1.
81 
82  ibit = iad2*8
83  CALL pkb( itryr, 16, msgot, ibit )
84  CALL pkb( itrmo, 8, msgot, ibit )
85  CALL pkb( itrdy, 8, msgot, ibit )
86  CALL pkb( itrhr, 8, msgot, ibit )
87  CALL pkb( itrmi, 8, msgot, ibit )
88 
89 C Copy Sections 2, 3, 4 and 5 from the input array to the
90 C output array.
91 
92  CALL mvb( msgin, iad2+1, msgot, (ibit/8)+1, lenm-iad2 )
93 
94  RETURN
95 900 CALL bort('BUFRLIB: ATRCPT - OVERFLOW OF OUTPUT MESSAGE '//
96  . 'ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY')
97  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:39
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
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:38
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:34
function iupbs01(MBAY, S01MNEM)
This function returns a specified value from within Section 0 or Section 1 of a BUFR message...
Definition: iupbs01.f:73