NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
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 
4 C> This subroutine reads an input BUFR message encoded using BUFR
5 C> edition 3 and outputs an equivalent BUFR message encoded using
6 C> BUFR edition 4.
7 C>
8 C> <p>This subroutine performs the same function as subroutine pkvs01()
9 C> when the latter is called with S01MNEM = 'BEN' and IVAL = 4, except
10 C> that the latter subroutine operates on BUFR messages internally
11 C> within the software, whereas this subroutine operates on a single
12 C> BUFR message passed in via a memory array.
13 C>
14 C> @author J. Ator
15 C> @date 2005-11-29
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 encoded using
22 C> BUFR edition 4
23 C>
24 C> @remarks
25 C> - MSGIN and MSGOT must be separate arrays.
26 C> - BUFR edition 4 messages are usually longer in length than their
27 C> BUFR edition 3 counterparts, so it's usually a good idea to allow
28 C> for extra space when allocating MSGOT within the application program.
29 C>
30 C> <b>Program history log:</b>
31 C> | Date | Programmer | Comments |
32 C> | -----|------------|----------|
33 C> | 2005-11-29 | J. Ator | Original author |
34 C> | 2009-08-12 | J. Ator | Allow silent return (instead of bort() return) if MSGIN is already encoded using edition 4 |
35 C>
36  SUBROUTINE cnved4(MSGIN,LMSGOT,MSGOT)
37 
38  dimension msgin(*), msgot(*)
39 
40  COMMON /hrdwrd/ nbytw,nbitw,iord(8)
41 
42 C-----------------------------------------------------------------------
43 C-----------------------------------------------------------------------
44 
45  IF(iupbs01(msgin,'BEN').EQ.4) THEN
46 
47 C The input message is already encoded using edition 4, so just
48 C copy it from MSGIN to MSGOT and then return.
49 
50  nmw = nmwrd(msgin)
51  IF(nmw.GT.lmsgot) goto 900
52  DO i = 1, nmw
53  msgot(i) = msgin(i)
54  ENDDO
55  RETURN
56  ENDIF
57 
58 C Get some section lengths and addresses from the input message.
59 
60  CALL getlens(msgin,3,len0,len1,len2,len3,l4,l5)
61 
62  iad2 = len0 + len1
63  iad4 = iad2 + len2 + len3
64 
65  lenm = iupbs01(msgin,'LENM')
66 
67 C Check for overflow of the output array. Note that the new
68 C edition 4 message will be a total of 3 bytes longer than the
69 C input message (i.e. 4 more bytes in Section 1, but 1 fewer
70 C byte in Section 3).
71 
72  lenmot = lenm + 3
73  IF(lenmot.GT.(lmsgot*nbytw)) goto 900
74 
75  len1ot = len1 + 4
76  len3ot = len3 - 1
77 
78 C Write Section 0 of the new message into the output array.
79 
80  CALL mvb( msgin, 1, msgot, 1, 4 )
81  ibit = 32
82  CALL pkb( lenmot, 24, msgot, ibit )
83  CALL pkb( 4, 8, msgot, ibit )
84 
85 C Write Section 1 of the new message into the output array.
86 
87  CALL pkb( len1ot, 24, msgot, ibit )
88  CALL pkb( iupbs01(msgin,'BMT'), 8, msgot, ibit )
89  CALL pkb( iupbs01(msgin,'OGCE'), 16, msgot, ibit )
90  CALL pkb( iupbs01(msgin,'GSES'), 16, msgot, ibit )
91  CALL pkb( iupbs01(msgin,'USN'), 8, msgot, ibit )
92  CALL pkb( iupbs01(msgin,'ISC2')*128, 8, msgot, ibit )
93  CALL pkb( iupbs01(msgin,'MTYP'), 8, msgot, ibit )
94 
95 C Set a default of 255 for the international subcategory.
96 
97  CALL pkb( 255, 8, msgot, ibit )
98  CALL pkb( iupbs01(msgin,'MSBT'), 8, msgot, ibit )
99  CALL pkb( iupbs01(msgin,'MTV'), 8, msgot, ibit )
100  CALL pkb( iupbs01(msgin,'MTVL'), 8, msgot, ibit )
101  CALL pkb( iupbs01(msgin,'YEAR'), 16, msgot, ibit )
102  CALL pkb( iupbs01(msgin,'MNTH'), 8, msgot, ibit )
103  CALL pkb( iupbs01(msgin,'DAYS'), 8, msgot, ibit )
104  CALL pkb( iupbs01(msgin,'HOUR'), 8, msgot, ibit )
105  CALL pkb( iupbs01(msgin,'MINU'), 8, msgot, ibit )
106 
107 C Set a default of 0 for the second.
108 
109  CALL pkb( 0, 8, msgot, ibit )
110 
111 C Copy Section 2 (if it exists) through the next-to-last byte
112 C of Section 3 from the input array to the output array.
113 
114  CALL mvb( msgin, iad2+1, msgot, (ibit/8)+1, len2+len3-1 )
115 
116 C Store the length of the new Section 3.
117 
118  ibit = ( len0 + len1ot + len2 ) * 8
119  CALL pkb( len3ot, 24, msgot, ibit )
120 
121 C Copy Section 4 and Section 5 from the input array to the
122 C output array.
123 
124  ibit = ibit + ( len3ot * 8 ) - 24
125  CALL mvb( msgin, iad4+1, msgot, (ibit/8)+1, lenm-iad4 )
126 
127  RETURN
128 900 CALL bort('BUFRLIB: CNVED4 - OVERFLOW OF OUTPUT (EDITION 4) '//
129  . 'MESSAGE ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY')
130  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
function nmwrd(MBAY)
GIVEN AN INTEGER ARRAY CONTAINING SECTION ZERO FROM A BUFR MESSAGE, THIS FUNCTION DETERMINES A COUNT ...
Definition: nmwrd.f:27
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:36
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
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