NCEPLIBS-bufr  11.5.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>
27 C> USAGE: CALL CMSGINI (LUN, MESG, SUBSET, IDATE, NSUB, NBYT)
28 C> INPUT ARGUMENT LIST:
29 C> LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
30 C> SUBSET - CHARACTER*8: TABLE A MNEMONIC FOR TYPE OF BUFR MESSAGE
31 C> BEING WRITTEN
32 C> IDATE - INTEGER: DATE-TIME STORED WITHIN SECTION 1 OF BUFR
33 C> MESSAGE BEING WRITTEN, IN FORMAT OF EITHER YYMMDDHH OR
34 C> YYYYMMDDHH, DEPENDING ON DATELEN() VALUE
35 C> NSUB - INTEGER: NUMBER OF SUBSETS, STORED IN SECTION 3 OF
36 C> BUFR MESSAGE BEING WRITTEN
37 C> NBYT - INTEGER: ACTUAL LENGTH (IN BYTES) OF "COMPRESSED DATA
38 C> PORTION" OF SECTION 4 (I.E. ALL OF SECTION 4 EXCEPT
39 C> FOR THE FIRST FOUR BYTES)
40 C>
41 C> OUTPUT ARGUMENT LIST:
42 C> MESG - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING BUFR
43 C> MESSAGE
44 C> NBYT - INTEGER: ACTUAL LENGTH OF BUFR MESSAGE (IN BYTES) UP
45 C> TO THE POINT IN SECTION 4 WHERE COMPRESSED DATA ARE
46 C> TO BE WRITTEN
47 C>
48 C> REMARKS:
49 C> THIS ROUTINE CALLS: BORT I4DY NEMTAB NEMTBA
50 C> PKB PKC
51 C> THIS ROUTINE IS CALLED BY: WRCMPS
52 C> Normally not called by any application
53 C> programs.
54 C>
55  SUBROUTINE cmsgini(LUN,MESG,SUBSET,IDATE,NSUB,NBYT)
56 
57  CHARACTER*128 bort_str
58  CHARACTER*8 subset
59  CHARACTER*4 bufr
60  CHARACTER*1 tab
61  dimension mesg(*)
62 
63  DATA bufr/'BUFR'/
64 
65 C-----------------------------------------------------------------------
66 C-----------------------------------------------------------------------
67 
68 C GET THE MESSAGE TAG AND TYPE, AND BREAK UP THE DATE
69 C ---------------------------------------------------
70 
71 c .... Given SUBSET, NEMTBA returns MTYP,MSBT,INOD
72  CALL nemtba(lun,subset,mtyp,msbt,inod)
73  CALL nemtab(lun,subset,isub,tab,iret)
74  IF(iret.EQ.0) goto 900
75 
76 C DATE CAN BE YYMMDDHH OR YYYYMMDDHH
77 C ----------------------------------
78 
79  jdate = i4dy(idate)
80  mcen = mod(jdate/10**8,100)+1
81  mear = mod(jdate/10**6,100)
82  mmon = mod(jdate/10**4,100)
83  mday = mod(jdate/10**2,100)
84  mour = mod(jdate ,100)
85  mmin = 0
86 
87 c .... DK: Don't think this can happen, because IDATE=0 is returned
88 c as 2000000000 by I4DY meaning MCEN would be 21
89  IF(mcen.EQ.1) goto 901
90 
91  IF(mear.EQ.0) mcen = mcen-1
92  IF(mear.EQ.0) mear = 100
93 
94 C INITIALIZE THE MESSAGE
95 C ----------------------
96 
97  mbit = 0
98 
99 C SECTION 0
100 C ---------
101 
102  CALL pkc(bufr , 4 , mesg,mbit)
103 
104 C NOTE THAT THE ACTUAL SECTION 0 LENGTH WILL BE COMPUTED AND
105 C STORED BELOW; FOR NOW, WE ARE REALLY ONLY INTERESTED IN
106 C ADVANCING MBIT BY THE CORRECT AMOUNT, SO WE'LL JUST STORE
107 C A DEFAULT VALUE OF 0.
108 
109  CALL pkb( 0 , 24 , mesg,mbit)
110  CALL pkb( 3 , 8 , mesg,mbit)
111 
112 C SECTION 1
113 C ---------
114 
115  len1 = 18
116 
117  CALL pkb(len1 , 24 , mesg,mbit)
118  CALL pkb( 0 , 8 , mesg,mbit)
119  CALL pkb( 3 , 8 , mesg,mbit)
120  CALL pkb( 7 , 8 , mesg,mbit)
121  CALL pkb( 0 , 8 , mesg,mbit)
122  CALL pkb( 0 , 8 , mesg,mbit)
123  CALL pkb(mtyp , 8 , mesg,mbit)
124  CALL pkb(msbt , 8 , mesg,mbit)
125  CALL pkb( 29 , 8 , mesg,mbit)
126  CALL pkb( 0 , 8 , mesg,mbit)
127  CALL pkb(mear , 8 , mesg,mbit)
128  CALL pkb(mmon , 8 , mesg,mbit)
129  CALL pkb(mday , 8 , mesg,mbit)
130  CALL pkb(mour , 8 , mesg,mbit)
131  CALL pkb(mmin , 8 , mesg,mbit)
132  CALL pkb(mcen , 8 , mesg,mbit)
133 
134 C SECTION 3
135 C ---------
136 
137  len3 = 10
138 
139  CALL pkb(len3 , 24 , mesg,mbit)
140  CALL pkb( 0 , 8 , mesg,mbit)
141  CALL pkb(nsub , 16 , mesg,mbit)
142  CALL pkb( 192 , 8 , mesg,mbit)
143  CALL pkb(isub , 16 , mesg,mbit)
144  CALL pkb( 0 , 8 , mesg,mbit)
145 
146 C SECTION 4
147 C ---------
148 
149 C STORE THE TOTAL LENGTH OF SECTION 4.
150 
151 C REMEMBER THAT THE INPUT VALUE OF NBYT ONLY CONTAINS THE
152 C LENGTH OF THE "COMPRESSED DATA PORTION" OF SECTION 4, SO
153 C WE NEED TO ADD FOUR BYTES TO THIS NUMBER IN ORDER TO
154 C ACCOUNT FOR THE TOTAL LENGTH OF SECTION 4.
155 
156  CALL pkb((nbyt+4) , 24 , mesg,mbit)
157  CALL pkb( 0 , 8 , mesg,mbit)
158 
159 C THE ACTUAL "COMPRESSED DATA PORTION" OF SECTION 4 WILL
160 C BE FILLED IN LATER BY SUBROUTINE WRCMPS.
161 
162 C SECTION 5
163 C ---------
164 
165 C THIS SECTION WILL BE FILLED IN LATER BY SUBROUTINE WRCMPS.
166 
167 C RETURN WITH THE CORRECT NEW MESSAGE BYTE COUNT
168 C ----------------------------------------------
169 
170 C NOW, NOTING THAT MBIT CURRENTLY POINTS TO THE LAST BIT OF
171 C THE FOURTH BYTE OF SECTION 4, THEN WE HAVE:
172 C (TOTAL LENGTH OF BUFR MESSAGE (IN SECTION 0)) =
173 C (LENGTH OF MESSAGE UP THROUGH FOURTH BYTE OF SECTION 4)
174 C + (LENGTH OF "COMPRESSED DATA PORTION" OF SECTION 4)
175 C + (LENGTH OF SECTION 5)
176  mbyt =
177  . mbit/8
178  . + nbyt
179  . + 4
180 
181 C NOW, MAKE NBYT POINT TO THE CURRENT LOCATION OF MBIT
182 C (I.E. THE BYTE AFTER WHICH TO ACTUALLY BEGIN WRITING THE
183 C COMPRESSED DATA INTO SECTION 4).
184 
185  nbyt = mbit/8
186 
187 C NOW, STORE THE TOTAL LENGTH OF THE BUFR MESSAGE (IN SECTION 0).
188 
189  mbit = 32
190  CALL pkb(mbyt,24,mesg,mbit)
191 
192 C EXITS
193 C -----
194 
195  RETURN
196 900 WRITE(bort_str,'("BUFRLIB: CMSGINI - TABLE A MESSAGE TYPE '//
197  . 'MNEMONIC ",A," NOT FOUND IN INTERNAL TABLE D ARRAYS")') subset
198  CALL bort(bort_str)
199 901 CALL bort
200  . ('BUFRLIB: CMSGINI - BUFR MESSAGE DATE (IDATE) is 0000000000')
201  END
function i4dy(IDATE)
THIS FUNCTION CONVERTS AN EIGHT DIGIT INTEGER DATE (YYMMDDHH) TO TEN DIGITS (YYYYMMDDHH) USING THE Y2...
Definition: i4dy.f:49
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:42
subroutine cmsgini(LUN, MESG, SUBSET, IDATE, NSUB, NBYT)
THIS SUBROUTINE INITIALIZES A NEW BUFR MESSAGE FOR OUTPUT IN COMPRESSED BUFR.
Definition: cmsgini.f:55
subroutine nemtab(LUN, NEMO, IDN, TAB, IRET)
THIS SUBROUTINE SEARCHES FOR MNEMONIC NEMO WITHIN THE INTERNAL TABLE B AND D ARRAYS HOLDING THE DICTI...
Definition: nemtab.f:66
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 nemtba(LUN, NEMO, MTYP, MSBT, INOD)
THIS SUBROUTINE SEARCHES FOR MNEMONIC NEMO WITHIN THE INTERNAL TABLE A ARRAYS HOLDING THE DICTIONARY ...
Definition: nemtba.f:50