NCEPLIBS-bufr  11.5.0
 All Data Structures Files Functions Variables Pages
wrcmps.f
Go to the documentation of this file.
1 C> @file
2 C> @author WOOLLEN @date 2002-05-14
3 
4 C> THIS SUBROUTINE PACKS UP THE CURRENT SUBSET WITHIN MEMORY
5 C> (ARRAY IBAY IN MODULE BITBUF), STORING IT FOR COMPRESSION.
6 C> IT THEN TRIES TO ADD IT TO THE COMPRESSED BUFR MESSAGE THAT IS
7 C> CURRENTLY OPEN WITHIN MEMORY FOR ABS(LUNIX) (ARRAY MGWA). IF THE
8 C> SUBSET WILL NOT FIT INTO THE CURRENTLY OPEN MESSAGE, THEN THAT
9 C> COMPRESSED MESSAGE IS FLUSHED TO LUNIX AND A NEW ONE IS CREATED IN
10 C> ORDER TO HOLD THE CURRENT SUBSET (STILL STORED FOR COMPRESSION).
11 C> THIS SUBROUTINE PERFORMS FUNCTIONS SIMILAR TO BUFR ARCHIVE LIBRARY
12 C> SUBROUTINE MSGUPD EXCEPT THAT IT ACTS ON COMPRESSED BUFR MESSAGES.
13 C>
14 C> PROGRAM HISTORY LOG:
15 C> 2002-05-14 J. WOOLLEN -- ORIGINAL AUTHOR
16 C> 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
17 C> INTERDEPENDENCIES
18 C> 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
19 C> INCREASED FROM 15000 TO 16000 (WAS IN
20 C> VERIFICATION VERSION); LOGICAL VARIABLES
21 C> "WRIT1" AND "FLUSH" NOW SAVED IN GLOBAL
22 C> MEMORY (IN COMMON BLOCK /COMPRS/), THIS
23 C> FIXED A BUG IN THIS ROUTINE WHICH CAN LEAD
24 C> TO MESSAGES BEING WRITTEN OUT BEFORE THEY
25 C> ARE FULL; UNIFIED/PORTABLE FOR WRF; ADDED
26 C> DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
27 C> MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
28 C> TERMINATES ABNORMALLY
29 C> 2004-08-18 J. ATOR -- REMOVE CALL TO XMSGINI (CMSGINI NOW HAS
30 C> SAME CAPABILITY); IMPROVE DOCUMENTATION;
31 C> CORRECT LOGIC FOR WHEN A CHARACTER VALUE IS
32 C> THE SAME FOR ALL SUBSETS IN A MESSAGE;
33 C> MAXIMUM MESSAGE LENGTH INCREASED FROM
34 C> 20,000 TO 50,000 BYTES
35 C> 2004-08-18 J. WOOLLEN -- 1) ADDED SAVE FOR LOGICAL 'FIRST'
36 C> 2) ADDED 'KMISS' TO FIX BUG WHICH WOULD
37 C> OCCASIONALLY SKIP OVER SUBSETS
38 C> 3) ADDED LOGIC TO MAKE SURE MISSING VALUES
39 C> ARE REPRESENTED BY INCREMENTS WITH ALL
40 C> BITS ON
41 C> 4) REMOVED TWO UNECESSARY REFERENCES TO
42 C> 'WRIT1'
43 C> 2005-11-29 J. ATOR -- FIX INITIALIZATION BUG FOR CHARACTER
44 C> COMPRESSION; INCREASE MXCSB TO 4000;
45 C> USE IUPBS01; CHECK EDITION NUMBER OF BUFR
46 C> MESSAGE BEFORE PADDING TO AN EVEN BYTE COUNT
47 C> 2009-03-23 J. ATOR -- ADDED SAVE FOR IBYT AND JBIT; USE MSGFULL
48 C> 2009-08-11 J. WOOLLEN -- MADE CATX AND CSTR BIGGER TO HANDLE LONGER
49 C> STRINGS. ALSO SEPARATED MATX,CATX,NCOL FROM
50 C> OTHER VARS IN COMMON COMPRS FOR USE IN
51 C> SUBROUTINE WRITLC. ALSO PASSED MBAY(1,LUN)
52 C> AS ARRAY TO INITIAL CALL TO CMSGINI IN ORDER
53 C> FOR USE BY WRITLC.
54 C> 2012-02-17 J. ATOR -- FIXED A BUG INVOLVING COMPRESSED FILES WITH
55 C> EMBEDDED DICTIONARY MESSAGES
56 C> 2014-12-03 J. ATOR -- USE PKX TO PACK LOCAL REFERENCE VALUE FOR
57 C> CHARACTER STRINGS
58 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
59 C> 2015-09-24 D. STOKES -- INCLUDE EDGE4 IN SAVE LIST
60 C> 2016-03-18 J. ATOR -- FIX BUG INVOLVING ENCODING OF LONG CHARACTER
61 C> STRINGS (VIA WRITLC) INTO MESSAGES WHICH
62 C> ALSO CONTAIN DELAYED REPLICATION SEQUENCES
63 C> 2021-02-24 J. ATOR -- USE IPKM AND PKC INSTEAD OF PKX
64 C>
65 C> USAGE: CALL WRCMPS (LUNIX)
66 C> INPUT ARGUMENT LIST:
67 C> LUNIX - INTEGER: ABSOLUTE VALUE IS FORTRAN LOGICAL UNIT NUMBER
68 C> FOR BUFR FILE (IF LUNIX IS LESS THAN ZERO, THIS IS A
69 C> "FLUSH" CALL AND THE BUFFER MUST BE CLEARED OUT)
70 C>
71 C> REMARKS:
72 C> THIS ROUTINE CALLS: BORT CMSGINI IUPBS01 MSGFULL
73 C> MSGWRT PKB PKC PKX
74 C> STATUS UPB UPC USRTPL
75 C> THIS ROUTINE IS CALLED BY: CLOSMG WRITSA WRITSB
76 C> Normally not called by any application
77 C> programs.
78 C>
79  SUBROUTINE wrcmps(LUNIX)
80 
81  USE moda_usrint
82  USE moda_msgcwd
83  USE moda_bitbuf
84  USE moda_mgwa
85  USE moda_tables
86  USE moda_comprx
87  USE moda_comprs
88  USE moda_s01cm
89 
90  COMMON /maxcmp/ maxcmb,maxrow,maxcol,ncmsgs,ncsubs,ncbyts
91 
92  CHARACTER*128 bort_str
93  CHARACTER*8 subset
94  CHARACTER*1 czero
95 
96  LOGICAL msgfull
97 
98 C NOTE THE FOLLOWING LOGICAL FLAGS:
99 C FIRST - KEEPS TRACK OF WHETHER THE CURRENT SUBSET IS THE
100 C FIRST SUBSET OF A NEW MESSAGE
101 C FLUSH - KEEPS TRACK OF WHETHER THIS SUBROUTINE WAS CALLED
102 C WITH LUNIX < 0 IN ORDER TO FORCIBLY FLUSH ANY
103 C PARTIALLY-COMPLETED MESSAGE WITHIN MEMORY (PRESUMABLY
104 C IMMEDIATELY PRIOR TO EXITING THE CALLING PROGRAM!)
105 C WRIT1 - KEEPS TRACK OF WHETHER THE CURRENT MESSAGE NEEDS
106 C TO BE WRITTEN OUT
107 
108  LOGICAL first,kmiss,edge4
109 
110  DATA first /.true./
111 
112  SAVE first,ibyt,jbit,subset,edge4
113 
114 C-----------------------------------------------------------------------
115  rln2 = 1./log(2.)
116 C-----------------------------------------------------------------------
117 
118 C GET THE UNIT AND SUBSET TAG
119 C ---------------------------
120 
121  lunit = abs(lunix)
122  CALL status(lunit,lun,il,im)
123 
124 C IF THIS IS A "FIRST" CALL, THEN INITIALIZE SOME VALUES IN
125 C ORDER TO PREPARE FOR THE CREATION OF A NEW COMPRESSED BUFR
126 C MESSAGE FOR OUTPUT.
127 
128  1 IF(first) THEN
129  kbyt = 0
130  ncol = 0
131  lunc = lun
132  nrow = nval(lun)
133  subset = tag(inode(lun))
134  first = .false.
135  flush = .false.
136  writ1 = .false.
137 
138 C THIS CALL TO CMSGINI IS DONE SOLELY IN ORDER TO DETERMINE
139 C HOW MANY BYTES (KBYT) WILL BE TAKEN UP IN A MESSAGE BY
140 C THE INFORMATION IN SECTIONS 0, 1, 2 AND 3. THIS WILL
141 C ALLOW US TO KNOW HOW MANY COMPRESSED DATA SUBSETS WILL
142 C FIT INTO SECTION 4 WITHOUT OVERFLOWING MAXCMB. LATER ON,
143 C A SEPARATE CALL TO CMSGINI WILL BE DONE TO ACTUALLY
144 C INITIALIZE SECTIONS 0, 1, 2 AND 3 OF THE FINAL COMPRESSED
145 C BUFR MESSAGE THAT WILL BE WRITTEN OUT.
146 
147  CALL cmsgini(lun,mbay(1,lun),subset,idate(lun),ncol,kbyt)
148 
149 C CHECK THE EDITION NUMBER OF THE BUFR MESSAGE TO BE CREATED
150 
151  edge4 = .false.
152  IF(ns01v.GT.0) THEN
153  ii = 1
154  DO WHILE ( (.NOT.edge4) .AND. (ii.LE.ns01v) )
155  IF( (cmnem(ii).EQ.'BEN') .AND. (ivmnem(ii).GE.4) ) THEN
156  edge4 = .true.
157  ELSE
158  ii = ii+1
159  ENDIF
160  ENDDO
161  ENDIF
162 
163  ENDIF
164 
165  IF(lun.NE.lunc) goto 900
166 
167 C IF THIS IS A "FLUSH" CALL, THEN CLEAR OUT THE BUFFER (NOTE THAT
168 C THERE IS NO CURRENT SUBSET TO BE STORED!) AND PREPARE TO WRITE
169 C THE FINAL COMPRESSED BUFR MESSAGE.
170 
171  IF(lunix.LT.0) THEN
172  IF(ncol.EQ.0) goto 100
173  IF(ncol.GT.0) THEN
174  flush = .true.
175  writ1 = .true.
176  icol = 1
177  goto 20
178  ENDIF
179  ENDIF
180 
181 C CHECK ON SOME OTHER POSSIBLY PROBLEMATIC SITUATIONS
182 C ---------------------------------------------------
183 
184  IF(ncol+1.GT.mxcsb) THEN
185  goto 50
186  ELSEIF(nval(lun).NE.nrow) THEN
187  writ1 = .true.
188  icol = 1
189  goto 20
190  ELSEIF(nval(lun).GT.mxcdv) THEN
191  goto 901
192  ENDIF
193 
194 C STORE THE NEXT SUBSET FOR COMPRESSION
195 C -------------------------------------
196 
197 C WILL THE CURRENT SUBSET FIT INTO THE CURRENT MESSAGE?
198 C (UNFORTUNATELY, THE ONLY WAY TO FIND OUT IS TO ACTUALLY
199 C RE-DO THE COMPRESSION BY RE-COMPUTING ALL OF THE LOCAL
200 C REFERENCE VALUES, INCREMENTS, ETC.)
201 
202  10 ncol = ncol+1
203  icol = ncol
204  ibit = 16
205  DO i=1,nval(lun)
206  node = inv(i,lun)
207  ityp(i) = itp(node)
208  iwid(i) = ibt(node)
209  IF(ityp(i).EQ.1.OR.ityp(i).EQ.2) THEN
210  CALL upb(matx(i,ncol),ibt(node),ibay,ibit)
211  ELSEIF(ityp(i).EQ.3) THEN
212  CALL upc(catx(i,ncol),ibt(node)/8,ibay,ibit,.true.)
213  ENDIF
214  ENDDO
215 
216 C COMPUTE THE MIN,MAX,WIDTH FOR EACH ROW - ACCUMULATE LENGTH
217 C ----------------------------------------------------------
218 
219 C LDATA WILL HOLD THE LENGTH IN BITS OF THE COMPRESSED DATA
220 C (I.E. THE SUM TOTAL FOR ALL DATA VALUES FOR ALL SUBSETS
221 C IN THE MESSAGE)
222 
223  20 ldata = 0
224  IF(ncol.LE.0) goto 902
225  DO i=1,nrow
226  IF(ityp(i).EQ.1 .OR. ityp(i).EQ.2) THEN
227 
228 C ROW I OF THE COMPRESSION MATRIX CONTAINS NUMERIC VALUES,
229 C SO KMIS(I) WILL STORE:
230 C .FALSE. IF ALL SUCH VALUES ARE NON-"MISSING"
231 C .TRUE. OTHERWISE
232 
233  imiss = 2**iwid(i)-1
234  IF(icol.EQ.1) THEN
235  kmin(i) = imiss
236  kmax(i) = 0
237  kmis(i) = .false.
238  ENDIF
239  DO j=icol,ncol
240  IF(matx(i,j).LT.imiss) THEN
241  kmin(i) = min(kmin(i),matx(i,j))
242  kmax(i) = max(kmax(i),matx(i,j))
243  ELSE
244  kmis(i) = .true.
245  ENDIF
246  ENDDO
247  kmiss = kmis(i).AND.kmin(i).LT.imiss
248  range = max(1,kmax(i)-kmin(i)+1)
249  IF(ityp(i).EQ.1.AND.range.GT.1) THEN
250 
251 C THE DATA VALUES IN ROW I OF THE COMPRESSION MATRIX
252 C ARE DELAYED DESCRIPTOR REPLICATION FACTORS AND ARE
253 C NOT ALL IDENTICAL (I.E. RANGE.GT.1), SO WE CANNOT
254 C COMPRESS ALL OF THESE SUBSETS INTO THE SAME MESSAGE.
255 C ASSUMING THAT NONE OF THE VALUES ARE "MISSING",
256 C EXCLUDE THE LAST SUBSET (I.E. THE LAST COLUMN
257 C OF THE MATRIX) AND TRY RE-COMPRESSING AGAIN.
258 
259  IF(kmiss) goto 903
260  writ1 = .true.
261  ncol = ncol-1
262  icol = 1
263  goto 20
264  ELSEIF(ityp(i).EQ.2.AND.(range.GT.1..OR.kmiss)) THEN
265 
266 C THE DATA VALUES IN ROW I OF THE COMPRESSION MATRIX
267 C ARE NUMERIC VALUES THAT ARE NOT ALL IDENTICAL.
268 C COMPUTE THE NUMBER OF BITS NEEDED TO HOLD THE
269 C LARGEST OF THE INCREMENTS.
270 
271  kbit(i) = nint(log(range)*rln2)
272  IF(2**kbit(i)-1.LE.range) kbit(i) = kbit(i)+1
273 
274 C HOWEVER, UNDER NO CIRCUMSTANCES SHOULD THIS NUMBER
275 C EVER EXCEED THE WIDTH OF THE ORIGINAL UNDERLYING
276 C DESCRIPTOR!
277 
278  IF(kbit(i).GT.iwid(i)) kbit(i) = iwid(i)
279  ELSE
280 
281 C THE DATA VALUES IN ROW I OF THE COMPRESSION MATRIX
282 C ARE NUMERIC VALUES THAT ARE ALL IDENTICAL, SO THE
283 C INCREMENTS WILL BE OMITTED FROM THE MESSAGE.
284 
285  kbit(i) = 0
286  ENDIF
287  ldata = ldata + iwid(i) + 6 + ncol*kbit(i)
288  ELSEIF(ityp(i).EQ.3) THEN
289 
290 C ROW I OF THE COMPRESSION MATRIX CONTAINS CHARACTER VALUES,
291 C SO KMIS(I) WILL STORE:
292 C .FALSE. IF ALL SUCH VALUES ARE IDENTICAL
293 C .TRUE. OTHERWISE
294 
295  IF(icol.EQ.1) THEN
296  cstr(i) = catx(i,1)
297  kmis(i) = .false.
298  ENDIF
299  DO j=icol,ncol
300  IF ( (.NOT.kmis(i)) .AND. (cstr(i).NE.catx(i,j)) ) THEN
301  kmis(i) = .true.
302  ENDIF
303  ENDDO
304  IF (kmis(i)) THEN
305 
306 C THE DATA VALUES IN ROW I OF THE COMPRESSION MATRIX
307 C ARE CHARACTER VALUES THAT ARE NOT ALL IDENTICAL.
308 
309  kbit(i) = iwid(i)
310  ELSE
311 
312 C THE DATA VALUES IN ROW I OF THE COMPRESSION MATRIX
313 C ARE CHARACTER VALUES THAT ARE ALL IDENTICAL, SO THE
314 C INCREMENTS WILL BE OMITTED FROM THE MESSAGE.
315 
316  kbit(i) = 0
317  ENDIF
318  ldata = ldata + iwid(i) + 6 + ncol*kbit(i)
319  ENDIF
320  ENDDO
321 
322 C ROUND DATA LENGTH UP TO A WHOLE BYTE COUNT
323 C ------------------------------------------
324 
325  ibyt = (ldata+8-mod(ldata,8))/8
326 
327 C DEPENDING ON THE EDITION NUMBER OF THE MESSAGE, WE NEED TO ENSURE
328 C THAT WE ROUND TO AN EVEN BYTE COUNT
329 
330  IF( (.NOT.edge4) .AND. (mod(ibyt,2).NE.0) ) ibyt = ibyt+1
331 
332  jbit = ibyt*8-ldata
333 
334 C CHECK ON COMPRESSED MESSAGE LENGTH, EITHER WRITE/RESTORE OR RETURN
335 C ------------------------------------------------------------------
336 
337  IF(msgfull(ibyt,kbyt,maxcmb)) THEN
338 
339 C THE CURRENT SUBSET WILL NOT FIT INTO THE CURRENT MESSAGE.
340 C SET THE FLAG TO INDICATE THAT A MESSAGE WRITE IS NEEDED,
341 C THEN GO BACK AND RE-COMPRESS THE SECTION 4 DATA FOR THIS
342 C MESSAGE WHILE *EXCLUDING* THE DATA FOR THE CURRENT SUBSET
343 C (WHICH WILL BE HELD AND STORED AS THE FIRST SUBSET OF A
344 C NEW MESSAGE AFTER WRITING THE CURRENT MESSAGE!).
345 
346  writ1 = .true.
347  ncol = ncol-1
348  icol = 1
349  goto 20
350  ELSEIF(.NOT.writ1) THEN
351 
352 C ADD THE CURRENT SUBSET TO THE CURRENT MESSAGE AND RETURN.
353 
354  CALL usrtpl(lun,1,1)
355  nsub(lun) = -ncol
356  goto 100
357  ENDIF
358 
359 C WRITE THE COMPLETE COMPRESSED MESSAGE
360 C -------------------------------------
361 
362 C NOW IT IS TIME TO DO THE "REAL" CALL TO CMSGINI TO ACTUALLY
363 C INITIALIZE SECTIONS 0, 1, 2 AND 3 OF THE FINAL COMPRESSED
364 C BUFR MESSAGE THAT WILL BE WRITTEN OUT.
365 
366  50 CALL cmsgini(lun,mgwa,subset,idate(lun),ncol,ibyt)
367 
368 C NOW ADD THE SECTION 4 DATA.
369 
370  ibit = ibyt*8
371  DO i=1,nrow
372  IF(ityp(i).EQ.1.OR.ityp(i).EQ.2) THEN
373  CALL pkb(kmin(i),iwid(i),mgwa,ibit)
374  CALL pkb(kbit(i), 6,mgwa,ibit)
375  IF(kbit(i).GT.0) THEN
376  DO j=1,ncol
377  IF(matx(i,j).LT.2**iwid(i)-1) THEN
378  incr = matx(i,j)-kmin(i)
379  ELSE
380  incr = 2**kbit(i)-1
381  ENDIF
382  CALL pkb(incr,kbit(i),mgwa,ibit)
383  ENDDO
384  ENDIF
385  ELSEIF(ityp(i).EQ.3) THEN
386  nchr = iwid(i)/8
387  IF(kbit(i).GT.0) THEN
388  CALL ipkm(czero,1,0)
389  DO j=1,nchr
390  CALL pkc(czero,1,mgwa,ibit)
391  ENDDO
392  CALL pkb(nchr, 6,mgwa,ibit)
393  DO j=1,ncol
394  CALL pkc(catx(i,j),nchr,mgwa,ibit)
395  ENDDO
396  ELSE
397  CALL pkc(cstr(i),nchr,mgwa,ibit)
398  CALL pkb( 0, 6,mgwa,ibit)
399  ENDIF
400  ENDIF
401  ENDDO
402 
403 C FILL IN THE END OF THE MESSAGE
404 C ------------------------------
405 
406 C PAD THE END OF SECTION 4 WITH ZEROES UP TO THE NECESSARY
407 C BYTE COUNT.
408 
409  CALL pkb( 0,jbit,mgwa,ibit)
410 
411 C ADD SECTION 5.
412 
413  CALL pkc('7777', 4,mgwa,ibit)
414 
415 C SEE THAT THE MESSAGE BYTE COUNTERS AGREE THEN WRITE A MESSAGE
416 C -------------------------------------------------------------
417 
418  IF(mod(ibit,8).NE.0) goto 904
419  lbyt = iupbs01(mgwa,'LENM')
420  nbyt = ibit/8
421  IF(nbyt.NE.lbyt) goto 905
422 
423  CALL msgwrt(lunit,mgwa,nbyt)
424 
425  maxrow = max(maxrow,nrow)
426  maxcol = max(maxcol,ncol)
427  ncmsgs = ncmsgs+1
428  ncsubs = ncsubs+ncol
429  ncbyts = ncbyts+nbyt
430 
431 C RESET
432 C -----
433 
434 C NOW, UNLESS THIS WAS A "FLUSH" CALL TO THIS SUBROUTINE, GO BACK
435 C AND INITIALIZE A NEW MESSAGE TO HOLD THE CURRENT SUBSET THAT WE
436 C WERE NOT ABLE TO FIT INTO THE MESSAGE THAT WAS JUST WRITTEN OUT.
437 
438  first = .true.
439  IF(.NOT.flush) goto 1
440 
441 C EXITS
442 C -----
443 
444 100 RETURN
445 900 WRITE(bort_str,'("BUFRLIB: WRCMPS - I/O STREAM INDEX FOR THIS '//
446  . .NE.'CALL (",I3,") I/O STREAM INDEX FOR INITIAL CALL (",I3,")'//
447  . ' - UNIT NUMBER NOW IS",I4)') lun,lunc,lunix
448  CALL bort(bort_str)
449 901 WRITE(bort_str,'("BUFRLIB: WRCMPS - NO. OF ELEMENTS IN THE '//
450  . .GT.'SUBSET (",I6,") THE NO. OF ROWS ALLOCATED FOR THE '//
451  . 'COMPRESSION MATRIX (",I6,")")') nval(lun),mxcdv
452  CALL bort(bort_str)
453 902 WRITE(bort_str,'("BUFRLIB: WRCMPS - NO. OF COLUMNS CALCULATED '//
454  . .LE.'FOR COMPRESSION MAXRIX IS 0 (=",I6,")")') ncol
455  CALL bort(bort_str)
456 903 CALL bort('BUFRLIB: WRCMPS - MISSING DELAYED REPLICATION FACTOR')
457 904 CALL bort('BUFRLIB: WRCMPS - THE NUMBER OF BITS IN THE '//
458  . 'COMPRESSED BUFR MSG IS NOT A MULTIPLE OF 8 - MSG MUST END ON '//
459  . ' A BYTE BOUNDARY')
460 905 WRITE(bort_str,'("BUFRLIB: WRCMPS - OUTPUT MESSAGE LENGTH FROM '//
461  . 'SECTION 0",I6," DOES NOT EQUAL FINAL PACKED MESSAGE LENGTH ("'//
462  .',I6,")")') lbyt,nbyt
463  CALL bort(bort_str)
464  END
subroutine msgwrt(LUNIT, MESG, MGBYT)
This subroutine performs final checks and updates on a BUFR message before writing it to a specified ...
Definition: msgwrt.f:69
subroutine upb(NVAL, NBITS, IBAY, IBIT)
THIS SUBROUTINE UNPACKS AND RETURNS A BINARY INTEGER CONTAINED WITHIN NBITS BITS OF IBAY...
Definition: upb.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 usrtpl(LUN, INVN, NBMP)
THIS SUBROUTINE STORES THE SUBSET TEMPLATE INTO INTERNAL SUBSET ARRAYS IN MODULE USRINT FOR CASES OF ...
Definition: usrtpl.f:51
subroutine wrcmps(LUNIX)
THIS SUBROUTINE PACKS UP THE CURRENT SUBSET WITHIN MEMORY (ARRAY IBAY IN MODULE BITBUF), STORING IT FOR COMPRESSION.
Definition: wrcmps.f:79
subroutine cmsgini(LUN, MESG, SUBSET, IDATE, NSUB, NBYT)
THIS SUBROUTINE INITIALIZES A NEW BUFR MESSAGE FOR OUTPUT IN COMPRESSED BUFR.
Definition: cmsgini.f:55
LOGICAL function msgfull(MSIZ, ITOADD, MXSIZ)
THIS LOGICAL FUNCTION DETERMINES WHETHER THE CURRENT SUBSET (OF LENGTH ITOADD BYTES) WILL FIT WITHIN ...
Definition: msgfull.f:26
subroutine upc(CHR, NCHR, IBAY, IBIT, CNVNULL)
THIS SUBROUTINE UNPACKS AND RETURNS A CHARACTER STRING OF LENGTH NCHR CONTAINED WITHIN NCHR BYTES OF ...
Definition: upc.f:49
This module contains array and variable declarations used to store the internal jump/link table...
Definition: moda_tables.F:13
subroutine status(LUNIT, LUN, IL, IM)
This subroutine checks whether a specified Fortran logical unit number is currently connected to the ...
Definition: status.f:61
subroutine ipkm(CBAY, NBYT, N)
This subroutine encodes an integer value within a specified number of bytes of a character string...
Definition: ipkm.f:29
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
This module contains array and variable declarations used to store BUFR messages internally for multi...
Definition: moda_bitbuf.F:10
function iupbs01(MBAY, S01MNEM)
This function returns a specified value from within Section 0 or Section 1 of a BUFR message...
Definition: iupbs01.f:72