NCEPLIBS-bufr  12.0.0
cnved4.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Convert a BUFR edition 3 message to BUFR edition 4.
3 C>
4 C> @author J. Ator @date 2005-11-29
5 
6 C> This subroutine reads an input BUFR message encoded using BUFR
7 C> edition 3 and outputs an equivalent BUFR message encoded using
8 C> BUFR edition 4.
9 C>
10 C> This subroutine performs the same function as subroutine pkvs01()
11 C> when the latter is called with S01MNEM = 'BEN' and IVAL = 4, except
12 C> that the latter subroutine operates on BUFR messages internally
13 C> within the software, whereas this subroutine operates on a single
14 C> BUFR message passed in via a memory array.
15 C>
16 C> @param[in] MSGIN -- integer(*): BUFR message
17 C> @param[in] LMSGOT -- integer: Dimensioned size (in integers) of
18 C> MSGOT; used by the subroutine to ensure that
19 C> it doesn't overflow the MSGOT array
20 C> @param[out] MSGOT -- integer(*): Copy of MSGIN encoded using
21 C> BUFR edition 4
22 C>
23 C> @remarks
24 C> - MSGIN and MSGOT must be separate arrays.
25 C> - BUFR edition 4 messages are usually longer in length than their
26 C> BUFR edition 3 counterparts, so it's usually a good idea to allow
27 C> for extra space when allocating MSGOT within the application program.
28 C>
29 C> @author J. Ator @date 2005-11-29
30  RECURSIVE SUBROUTINE cnved4(MSGIN,LMSGOT,MSGOT)
31 
32  USE modv_im8b
33 
34  dimension msgin(*), msgot(*)
35 
36  COMMON /hrdwrd/ nbytw,nbitw,iord(8)
37 
38 C-----------------------------------------------------------------------
39 C-----------------------------------------------------------------------
40 
41 C Check for I8 integers.
42 
43  IF(im8b) THEN
44  im8b=.false.
45 
46  CALL x84 ( lmsgot, my_lmsgot, 1 )
47  CALL cnved4 ( msgin, my_lmsgot*2, msgot )
48 
49  im8b=.true.
50  RETURN
51  ENDIF
52 
53  IF(iupbs01(msgin,'BEN').EQ.4) THEN
54 
55 C The input message is already encoded using edition 4, so just
56 C copy it from MSGIN to MSGOT and then return.
57 
58  nmw = nmwrd(msgin)
59  IF(nmw.GT.lmsgot) GOTO 900
60  DO i = 1, nmw
61  msgot(i) = msgin(i)
62  ENDDO
63  RETURN
64  ENDIF
65 
66 C Get some section lengths and addresses from the input message.
67 
68  CALL getlens(msgin,3,len0,len1,len2,len3,l4,l5)
69 
70  iad2 = len0 + len1
71  iad4 = iad2 + len2 + len3
72 
73  lenm = iupbs01(msgin,'LENM')
74 
75 C Check for overflow of the output array. Note that the new
76 C edition 4 message will be a total of 3 bytes longer than the
77 C input message (i.e. 4 more bytes in Section 1, but 1 fewer
78 C byte in Section 3).
79 
80  lenmot = lenm + 3
81  IF(lenmot.GT.(lmsgot*nbytw)) GOTO 900
82 
83  len1ot = len1 + 4
84  len3ot = len3 - 1
85 
86 C Write Section 0 of the new message into the output array.
87 
88  CALL mvb ( msgin, 1, msgot, 1, 4 )
89  ibit = 32
90  CALL pkb ( lenmot, 24, msgot, ibit )
91  CALL pkb ( 4, 8, msgot, ibit )
92 
93 C Write Section 1 of the new message into the output array.
94 
95  CALL pkb ( len1ot, 24, msgot, ibit )
96  CALL pkb ( iupbs01(msgin,'BMT'), 8, msgot, ibit )
97  CALL pkb ( iupbs01(msgin,'OGCE'), 16, msgot, ibit )
98  CALL pkb ( iupbs01(msgin,'GSES'), 16, msgot, ibit )
99  CALL pkb ( iupbs01(msgin,'USN'), 8, msgot, ibit )
100  CALL pkb ( iupbs01(msgin,'ISC2')*128, 8, msgot, ibit )
101  CALL pkb ( iupbs01(msgin,'MTYP'), 8, msgot, ibit )
102 
103 C Set a default of 255 for the international subcategory.
104 
105  CALL pkb ( 255, 8, msgot, ibit )
106  CALL pkb ( iupbs01(msgin,'MSBT'), 8, msgot, ibit )
107  CALL pkb ( iupbs01(msgin,'MTV'), 8, msgot, ibit )
108  CALL pkb ( iupbs01(msgin,'MTVL'), 8, msgot, ibit )
109  CALL pkb ( iupbs01(msgin,'YEAR'), 16, msgot, ibit )
110  CALL pkb ( iupbs01(msgin,'MNTH'), 8, msgot, ibit )
111  CALL pkb ( iupbs01(msgin,'DAYS'), 8, msgot, ibit )
112  CALL pkb ( iupbs01(msgin,'HOUR'), 8, msgot, ibit )
113  CALL pkb ( iupbs01(msgin,'MINU'), 8, msgot, ibit )
114 
115 C Set a default of 0 for the second.
116 
117  CALL pkb ( 0, 8, msgot, ibit )
118 
119 C Copy Section 2 (if it exists) through the next-to-last byte
120 C of Section 3 from the input array to the output array.
121 
122  CALL mvb ( msgin, iad2+1, msgot, (ibit/8)+1, len2+len3-1 )
123 
124 C Store the length of the new Section 3.
125 
126  ibit = ( len0 + len1ot + len2 ) * 8
127  CALL pkb ( len3ot, 24, msgot, ibit )
128 
129 C Copy Section 4 and Section 5 from the input array to the
130 C output array.
131 
132  ibit = ibit + ( len3ot * 8 ) - 24
133  CALL mvb ( msgin, iad4+1, msgot, (ibit/8)+1, lenm-iad4 )
134 
135  RETURN
136 900 CALL bort('BUFRLIB: CNVED4 - OVERFLOW OF OUTPUT (EDITION 4) '//
137  . 'MESSAGE ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY')
138  END
subroutine bort(STR)
Log one error message and abort application program.
Definition: bort.f:18
recursive subroutine cnved4(MSGIN, LMSGOT, MSGOT)
This subroutine reads an input BUFR message encoded using BUFR edition 3 and outputs an equivalent BU...
Definition: cnved4.f:31
recursive 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:36
recursive function iupbs01(MBAY, S01MNEM)
Read a data value from Section 0 or Section 1 of a BUFR message.
Definition: iupbs01.f:69
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:18
This module declares and initializes the IM8B variable.
logical, public im8b
Status indicator to keep track of whether all future calls to BUFRLIB subroutines and functions from ...
recursive function nmwrd(MBAY)
Given an integer array containing Section 0 from a BUFR message, this function determines the array s...
Definition: nmwrd.f:24
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:28
subroutine x84(IIN8, IOUT4, NVAL)
Encode one or more 8-byte integer values as 4-byte integer values.
Definition: x84.F:19