NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
cmsgini.f
Go to the documentation of this file.
1 C> @file
2 C> @author WOOLLEN @date 2002-05-14
3 
4 C> THIS SUBROUTINE INITIALIZES A NEW BUFR MESSAGE FOR OUTPUT
5 C> IN COMPRESSED BUFR. THE ACTUAL LENGTH OF SECTION 4 (CONTAINING
6 C> COMPRESSED DATA) IS ALREADY KNOWN.
7 C>
8 C> PROGRAM HISTORY LOG:
9 C> 2002-05-14 J. WOOLLEN -- ORIGINAL AUTHOR
10 C> 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
11 C> INTERDEPENDENCIES
12 C> 2003-11-04 D. KEYSER -- UNIFIED/PORTABLE FOR WRF; ADDED
13 C> DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
14 C> MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
15 C> TERMINATES ABNORMALLY; LEN3 INITIALIZED AS
16 C> ZERO (BEFORE WAS UNDEFINED WHEN FIRST
17 C> REFERENCED)
18 C> 2004-08-18 J. ATOR -- ADDED COMMON /MSGSTD/ AND OTHER LOGIC TO
19 C> ALLOW OPTION OF CREATING A SECTION 3 THAT IS
20 C> FULLY WMO-STANDARD; IMPROVED DOCUMENTATION;
21 C> MAXIMUM MESSAGE LENGTH INCREASED FROM
22 C> 20,000 TO 50,000 BYTES
23 C> 2005-11-29 J. ATOR -- CHANGED DEFAULT MASTER TABLE VERSION TO 12
24 C> 2009-05-07 J. ATOR -- CHANGED DEFAULT MASTER TABLE VERSION TO 13;
25 C> REMOVED STANDARDIZATION LOGIC FOR SECTION 3
26 C> 2019-05-21 J. ATOR -- CHANGED DEFAULT MASTER TABLE VERSION TO 29
27 C> 2021-05-14 J. ATOR -- CHANGED DEFAULT MASTER TABLE VERSION TO 36
28 C>
29 C> USAGE: CALL CMSGINI (LUN, MESG, SUBSET, IDATE, NSUB, NBYT)
30 C> INPUT ARGUMENT LIST:
31 C> LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
32 C> SUBSET - CHARACTER*8: TABLE A MNEMONIC FOR TYPE OF BUFR MESSAGE
33 C> BEING WRITTEN
34 C> IDATE - INTEGER: DATE-TIME STORED WITHIN SECTION 1 OF BUFR
35 C> MESSAGE BEING WRITTEN, IN FORMAT OF EITHER YYMMDDHH OR
36 C> YYYYMMDDHH, DEPENDING ON DATELEN() VALUE
37 C> NSUB - INTEGER: NUMBER OF SUBSETS, STORED IN SECTION 3 OF
38 C> BUFR MESSAGE BEING WRITTEN
39 C> NBYT - INTEGER: ACTUAL LENGTH (IN BYTES) OF "COMPRESSED DATA
40 C> PORTION" OF SECTION 4 (I.E. ALL OF SECTION 4 EXCEPT
41 C> FOR THE FIRST FOUR BYTES)
42 C>
43 C> OUTPUT ARGUMENT LIST:
44 C> MESG - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING BUFR
45 C> MESSAGE
46 C> NBYT - INTEGER: ACTUAL LENGTH OF BUFR MESSAGE (IN BYTES) UP
47 C> TO THE POINT IN SECTION 4 WHERE COMPRESSED DATA ARE
48 C> TO BE WRITTEN
49 C>
50 C> REMARKS:
51 C> THIS ROUTINE CALLS: BORT I4DY NEMTAB NEMTBA
52 C> PKB PKC
53 C> THIS ROUTINE IS CALLED BY: WRCMPS
54 C> Normally not called by any application
55 C> programs.
56 C>
57  SUBROUTINE cmsgini(LUN,MESG,SUBSET,IDATE,NSUB,NBYT)
58 
59  CHARACTER*128 bort_str
60  CHARACTER*8 subset
61  CHARACTER*4 bufr
62  CHARACTER*1 tab
63  dimension mesg(*)
64 
65  DATA bufr/'BUFR'/
66 
67 C-----------------------------------------------------------------------
68 C-----------------------------------------------------------------------
69 
70 C GET THE MESSAGE TAG AND TYPE, AND BREAK UP THE DATE
71 C ---------------------------------------------------
72 
73 c .... Given SUBSET, NEMTBA returns MTYP,MSBT,INOD
74  CALL nemtba(lun,subset,mtyp,msbt,inod)
75  CALL nemtab(lun,subset,isub,tab,iret)
76  IF(iret.EQ.0) goto 900
77 
78 C DATE CAN BE YYMMDDHH OR YYYYMMDDHH
79 C ----------------------------------
80 
81  jdate = i4dy(idate)
82  mcen = mod(jdate/10**8,100)+1
83  mear = mod(jdate/10**6,100)
84  mmon = mod(jdate/10**4,100)
85  mday = mod(jdate/10**2,100)
86  mour = mod(jdate ,100)
87  mmin = 0
88 
89 c .... DK: Don't think this can happen, because IDATE=0 is returned
90 c as 2000000000 by I4DY meaning MCEN would be 21
91  IF(mcen.EQ.1) goto 901
92 
93  IF(mear.EQ.0) mcen = mcen-1
94  IF(mear.EQ.0) mear = 100
95 
96 C INITIALIZE THE MESSAGE
97 C ----------------------
98 
99  mbit = 0
100 
101 C SECTION 0
102 C ---------
103 
104  CALL pkc(bufr , 4 , mesg,mbit)
105 
106 C NOTE THAT THE ACTUAL SECTION 0 LENGTH WILL BE COMPUTED AND
107 C STORED BELOW; FOR NOW, WE ARE REALLY ONLY INTERESTED IN
108 C ADVANCING MBIT BY THE CORRECT AMOUNT, SO WE'LL JUST STORE
109 C A DEFAULT VALUE OF 0.
110 
111  CALL pkb( 0 , 24 , mesg,mbit)
112  CALL pkb( 3 , 8 , mesg,mbit)
113 
114 C SECTION 1
115 C ---------
116 
117  len1 = 18
118 
119  CALL pkb(len1 , 24 , mesg,mbit)
120  CALL pkb( 0 , 8 , mesg,mbit)
121  CALL pkb( 3 , 8 , mesg,mbit)
122  CALL pkb( 7 , 8 , mesg,mbit)
123  CALL pkb( 0 , 8 , mesg,mbit)
124  CALL pkb( 0 , 8 , mesg,mbit)
125  CALL pkb(mtyp , 8 , mesg,mbit)
126  CALL pkb(msbt , 8 , mesg,mbit)
127  CALL pkb( 36 , 8 , mesg,mbit)
128  CALL pkb( 0 , 8 , mesg,mbit)
129  CALL pkb(mear , 8 , mesg,mbit)
130  CALL pkb(mmon , 8 , mesg,mbit)
131  CALL pkb(mday , 8 , mesg,mbit)
132  CALL pkb(mour , 8 , mesg,mbit)
133  CALL pkb(mmin , 8 , mesg,mbit)
134  CALL pkb(mcen , 8 , mesg,mbit)
135 
136 C SECTION 3
137 C ---------
138 
139  len3 = 10
140 
141  CALL pkb(len3 , 24 , mesg,mbit)
142  CALL pkb( 0 , 8 , mesg,mbit)
143  CALL pkb(nsub , 16 , mesg,mbit)
144  CALL pkb( 192 , 8 , mesg,mbit)
145  CALL pkb(isub , 16 , mesg,mbit)
146  CALL pkb( 0 , 8 , mesg,mbit)
147 
148 C SECTION 4
149 C ---------
150 
151 C STORE THE TOTAL LENGTH OF SECTION 4.
152 
153 C REMEMBER THAT THE INPUT VALUE OF NBYT ONLY CONTAINS THE
154 C LENGTH OF THE "COMPRESSED DATA PORTION" OF SECTION 4, SO
155 C WE NEED TO ADD FOUR BYTES TO THIS NUMBER IN ORDER TO
156 C ACCOUNT FOR THE TOTAL LENGTH OF SECTION 4.
157 
158  CALL pkb((nbyt+4) , 24 , mesg,mbit)
159  CALL pkb( 0 , 8 , mesg,mbit)
160 
161 C THE ACTUAL "COMPRESSED DATA PORTION" OF SECTION 4 WILL
162 C BE FILLED IN LATER BY SUBROUTINE WRCMPS.
163 
164 C SECTION 5
165 C ---------
166 
167 C THIS SECTION WILL BE FILLED IN LATER BY SUBROUTINE WRCMPS.
168 
169 C RETURN WITH THE CORRECT NEW MESSAGE BYTE COUNT
170 C ----------------------------------------------
171 
172 C NOW, NOTING THAT MBIT CURRENTLY POINTS TO THE LAST BIT OF
173 C THE FOURTH BYTE OF SECTION 4, THEN WE HAVE:
174 C (TOTAL LENGTH OF BUFR MESSAGE (IN SECTION 0)) =
175 C (LENGTH OF MESSAGE UP THROUGH FOURTH BYTE OF SECTION 4)
176 C + (LENGTH OF "COMPRESSED DATA PORTION" OF SECTION 4)
177 C + (LENGTH OF SECTION 5)
178  mbyt =
179  . mbit/8
180  . + nbyt
181  . + 4
182 
183 C NOW, MAKE NBYT POINT TO THE CURRENT LOCATION OF MBIT
184 C (I.E. THE BYTE AFTER WHICH TO ACTUALLY BEGIN WRITING THE
185 C COMPRESSED DATA INTO SECTION 4).
186 
187  nbyt = mbit/8
188 
189 C NOW, STORE THE TOTAL LENGTH OF THE BUFR MESSAGE (IN SECTION 0).
190 
191  mbit = 32
192  CALL pkb(mbyt,24,mesg,mbit)
193 
194 C EXITS
195 C -----
196 
197  RETURN
198 900 WRITE(bort_str,'("BUFRLIB: CMSGINI - TABLE A MESSAGE TYPE '//
199  . 'MNEMONIC ",A," NOT FOUND IN INTERNAL TABLE D ARRAYS")') subset
200  CALL bort(bort_str)
201 901 CALL bort
202  . ('BUFRLIB: CMSGINI - BUFR MESSAGE DATE (IDATE) is 0000000000')
203  END
i4dy
function i4dy(IDATE)
This function converts a date-time with a 2-digit year (YYMMDDHH) to a date-time with a 4-digit year ...
Definition: i4dy.f:31
pkc
subroutine pkc(CHR, NCHR, IBAY, IBIT)
This subroutine encodes a character string within a specified number of bits of an integer array...
Definition: pkc.f:40
cmsgini
subroutine cmsgini(LUN, MESG, SUBSET, IDATE, NSUB, NBYT)
THIS SUBROUTINE INITIALIZES A NEW BUFR MESSAGE FOR OUTPUT IN COMPRESSED BUFR.
Definition: cmsgini.f:57
nemtab
subroutine nemtab(LUN, NEMO, IDN, TAB, IRET)
This subroutine returns information about a descriptor from the internal DX BUFR tables, based on the mnemonic associated with that descriptor.
Definition: nemtab.f:44
bort
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
pkb
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
nemtba
subroutine nemtba(LUN, NEMO, MTYP, MSBT, INOD)
This subroutine searches for a descriptor within Table A of the internal DX BUFR tables.
Definition: nemtba.f:35