NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
msgupd.f
Go to the documentation of this file.
1 C> @file
2 C> @author WOOLLEN @date 1994-01-06
3 
4 C> THIS SUBROUTINE PACKS UP THE CURRENT SUBSET WITHIN MEMORY
5 C> (ARRAY IBAY IN MODULE BITBUF) AND THEN TRIES TO ADD IT TO
6 C> THE BUFR MESSAGE THAT IS CURRENTLY OPEN WITHIN MEMORY FOR LUNIT
7 C> (ARRAY MBAY IN MODULE BITBUF). IF THE SUBSET WILL NOT FIT
8 C> INTO THE CURRENTLY OPEN MESSAGE, OR IF THE SUBSET BYTE COUNT EXCEEDS
9 C> 65530 (SUFFICIENTLY CLOSE TO THE 16-BIT BYTE COUNTER UPPER LIMIT OF
10 C> 65535), THEN THAT MESSAGE IS FLUSHED TO LUNIT AND A NEW ONE IS
11 C> CREATED IN ORDER TO HOLD THE CURRENT SUBSET. ANY SUBSET WITH BYTE
12 C> COUNT > 65530 WILL BE WRITTEN INTO ITS OWN ONE-SUBSET MESSAGE.
13 C> IF THE CURRENT SUBSET IS LARGER THAN THE MAXIMUM MESSAGE LENGTH,
14 C> THEN THE SUBSET IS DISCARDED AND A DIAGNOSTIC IS PRINTED.
15 C>
16 C> PROGRAM HISTORY LOG:
17 C> 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
18 C> 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
19 C> "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
20 C> ROUTINE "BORT"
21 C> 1998-12-14 J. WOOLLEN -- NO LONGER CALLS BORT IF A SUBSET IS LARGER
22 C> THAN A MESSAGE, JUST DISCARDS THE SUBSET
23 C> 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
24 C> OPENED AT ONE TIME INCREASED FROM 10 TO 32
25 C> (NECESSARY IN ORDER TO PROCESS MULTIPLE
26 C> BUFR FILES UNDER THE MPI)
27 C> 2000-09-19 J. WOOLLEN -- MAXIMUM MESSAGE LENGTH INCREASED FROM
28 C> 10,000 TO 20,000 BYTES
29 C> 2003-11-04 J. ATOR -- ADDED DOCUMENTATION
30 C> 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
31 C> INTERDEPENDENCIES
32 C> 2003-11-04 D. KEYSER -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
33 C> DOCUMENTATION
34 C> 2004-08-09 J. ATOR -- MAXIMUM MESSAGE LENGTH INCREASED FROM
35 C> 20,000 TO 50,000 BYTES
36 C> 2009-03-23 J. ATOR -- USE MSGFULL AND ERRWRT
37 C> 2014-10-20 J. WOOLLEN -- ACCOUNT FOR SUBSETS WITH BYTE COUNT > 65530
38 C> (THESE MUST BE WRITTEN INTO THEIR OWN
39 C> ONE-SUBSET MESSAGE)
40 C> 2014-10-20 D. KEYSER -- FOR CASE ABOVE, DO NOT WRITE "CURRENT"
41 C> MESSAGE IF IT CONTAINS ZERO SUBSETS
42 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
43 C> 2016-03-21 D. STOKES -- CALL USRTPL FOR OVERLARGE SUBSETS
44 C>
45 C> USAGE: CALL MSGUPD (LUNIT, LUN)
46 C> INPUT ARGUMENT LIST:
47 C> LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
48 C> LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
49 C> (ASSOCIATED WITH FILE CONNECTED TO LOGICAL UNIT LUNIT)
50 C>
51 C> REMARKS:
52 C> THIS ROUTINE CALLS: ERRWRT IUPB MSGFULL MSGINI
53 C> MSGWRT MVB PAD PKB
54 C> USRTPL WRITLC
55 C> THIS ROUTINE IS CALLED BY: WRITSA WRITSB
56 C> Normally not called by any application
57 C> programs.
58 C>
59  SUBROUTINE msgupd(LUNIT,LUN)
60 
61  USE moda_msgcwd
62  USE moda_bitbuf
63  USE moda_h4wlc
64 
65  COMMON /msgptr/ nby0,nby1,nby2,nby3,nby4,nby5
66  COMMON /quiet / iprt
67 
68  LOGICAL msgfull
69 
70  CHARACTER*128 errstr
71 
72 C-----------------------------------------------------------------------
73 C-----------------------------------------------------------------------
74 
75 C PAD THE SUBSET BUFFER
76 C ---------------------
77 
78  CALL pad(ibay,ibit,ibyt,8)
79 
80 C CHECK WHETHER THE NEW SUBSET SHOULD BE WRITTEN INTO THE CURRENTLY
81 C OPEN MESSAGE
82 C -----------------------------------------------------------------
83 
84  IF(msgfull(mbyt(lun),ibyt,maxbyt)
85  . .OR.
86  . ((ibyt.GT.65530).AND.(nsub(lun).GT.0))) THEN
87 c NO it should not, either because:
88 c 1) it doesn't fit,
89 c -- OR --
90 c 2) it has byte count > 65530 (sufficiently close to the
91 c upper limit for the 16 bit byte counter placed at the
92 c beginning of each subset), AND the current message has
93 c at least one subset in it,
94 c SO write the current message out and create a new one to
95 c hold the current subset
96  CALL msgwrt(lunit,mbay(1,lun),mbyt(lun))
97  CALL msgini(lun)
98  ENDIF
99 
100  IF(msgfull(mbyt(lun),ibyt,maxbyt)) THEN
101 c This is an overlarge subset that won't fit in any message
102 c given the current value of MAXBYT, so discard the subset
103 c and exit gracefully.
104  IF(iprt.GE.0) THEN
105  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
106  WRITE ( unit=errstr, fmt='(A,A,I7,A)')
107  . 'BUFRLIB: MSGUPD - SUBSET LONGER THAN ANY POSSIBLE MESSAGE ',
108  . '{MAXIMUM MESSAGE LENGTH = ', maxbyt, '}'
109  CALL errwrt(errstr)
110  CALL errwrt('>>>>>>>OVERLARGE SUBSET DISCARDED FROM FILE<<<<<<<<')
111  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
112  CALL errwrt(' ')
113  ENDIF
114  goto 100
115  ENDIF
116 
117 C SET A BYTE COUNT AND TRANSFER THE SUBSET BUFFER INTO THE MESSAGE
118 C ----------------------------------------------------------------
119 
120  lbit = 0
121  CALL pkb(ibyt,16,ibay,lbit)
122 
123 C Note that we want to append the data for this subset to the end
124 C of Section 4, but the value in MBYT(LUN) already includes the
125 C length of Section 5 (i.e. 4 bytes). Therefore, we need to begin
126 C writing at the point 3 bytes prior to the byte currently pointed
127 C to by MBYT(LUN).
128 
129  CALL mvb(ibay,1,mbay(1,lun),mbyt(lun)-3,ibyt)
130 
131 C UPDATE THE SUBSET AND BYTE COUNTERS
132 C --------------------------------------
133 
134  mbyt(lun) = mbyt(lun) + ibyt
135  nsub(lun) = nsub(lun) + 1
136 
137  lbit = (nby0+nby1+nby2+4)*8
138  CALL pkb(nsub(lun),16,mbay(1,lun),lbit)
139 
140  lbyt = nby0+nby1+nby2+nby3
141  nbyt = iupb(mbay(1,lun),lbyt+1,24)
142  lbit = lbyt*8
143  CALL pkb(nbyt+ibyt,24,mbay(1,lun),lbit)
144 
145 C IF ANY LONG CHARACTER STRINGS ARE BEING HELD INTERNALLY FOR STORAGE
146 C INTO THIS SUBSET, STORE THEM NOW.
147 C -------------------------------------------------------------------
148 
149  IF(nh4wlc.GT.0) THEN
150  DO ii = 1, nh4wlc
151  CALL writlc(luh4wlc(ii),chh4wlc(ii),sth4wlc(ii))
152  ENDDO
153  nh4wlc = 0
154  ENDIF
155 
156 C IF THE SUBSET BYTE COUNT IS > 65530, THEN GIVE IT ITS OWN ONE-SUBSET
157 C MESSAGE (CANNOT HAVE ANY OTHER SUBSETS IN THIS MESSAGE BECAUSE THEIR
158 C BEGINNING WOULD BE BEYOND THE UPPER LIMIT OF 65535 IN THE 16-BIT
159 C BYTE COUNTER, MEANING THEY COULD NOT BE LOCATED!)
160 C --------------------------------------------------------------------
161 
162  IF(ibyt.GT.65530) THEN
163  IF(iprt.GE.1) THEN
164  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
165  WRITE ( unit=errstr, fmt='(A,I7,A,A)')
166  . 'BUFRLIB: MSGUPD - SUBSET HAS BYTE COUNT = ',ibyt,' > UPPER ',
167  . 'LIMIT OF 65535'
168  CALL errwrt(errstr)
169  CALL errwrt('>>>>>>>WILL BE WRITTEN INTO ITS OWN MESSAGE<<<<<<<<')
170  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
171  CALL errwrt(' ')
172  ENDIF
173  CALL msgwrt(lunit,mbay(1,lun),mbyt(lun))
174  CALL msgini(lun)
175  ENDIF
176 
177 C RESET THE USER ARRAYS AND EXIT NORMALLY
178 C ---------------------------------------
179 
180 100 CALL usrtpl(lun,1,1)
181 
182 C EXIT
183 C ----
184 
185  RETURN
186  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:54
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
subroutine msgupd(LUNIT, LUN)
THIS SUBROUTINE PACKS UP THE CURRENT SUBSET WITHIN MEMORY (ARRAY IBAY IN MODULE BITBUF) AND THEN TRIE...
Definition: msgupd.f:59
function iupb(MBAY, NBYT, NBIT)
THIS FUNCTION UNPACKS AND RETURNS A BINARY INTEGER WORD CONTAINED WITHIN NBIT BITS OF A BUFR MESSAGE ...
Definition: iupb.f:36
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 pad(IBAY, IBIT, IBYT, IPADB)
THIS SUBROUTINE FIRST PACKS THE VALUE FOR THE NUMBER OF BITS BEING &quot;PADDED&quot; (WE&#39;LL GET TO THAT LATE...
Definition: pad.f:52
LOGICAL function msgfull(MSIZ, ITOADD, MXSIZ)
This function determines whether the current data subset in the internal arrays will fit within the c...
Definition: msgfull.f:25
subroutine msgini(LUN)
THIS SUBROUTINE INITIALIZES, WITHIN THE INTERNAL ARRAYS, A NEW BUFR MESSAGE FOR OUTPUT.
Definition: msgini.f:57
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
Definition: errwrt.f:41
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
This module contains array and variable declarations used to store BUFR messages internally for multi...
Definition: moda_bitbuf.F:10
subroutine writlc(LUNIT, CHR, STR)
This subroutine writes a long character string (greater than 8 bytes) to a data subset.
Definition: writlc.f:59