NCEPLIBS-bufr 11.7.1
All Data Structures Namespaces Files Functions Variables Pages
msgupd.f
Go to the documentation of this file.
1C> @file
2C> @author WOOLLEN @date 1994-01-06
3
4C> THIS SUBROUTINE PACKS UP THE CURRENT SUBSET WITHIN MEMORY
5C> (ARRAY IBAY IN MODULE BITBUF) AND THEN TRIES TO ADD IT TO
6C> THE BUFR MESSAGE THAT IS CURRENTLY OPEN WITHIN MEMORY FOR LUNIT
7C> (ARRAY MBAY IN MODULE BITBUF). IF THE SUBSET WILL NOT FIT
8C> INTO THE CURRENTLY OPEN MESSAGE, OR IF THE SUBSET BYTE COUNT EXCEEDS
9C> 65530 (SUFFICIENTLY CLOSE TO THE 16-BIT BYTE COUNTER UPPER LIMIT OF
10C> 65535), THEN THAT MESSAGE IS FLUSHED TO LUNIT AND A NEW ONE IS
11C> CREATED IN ORDER TO HOLD THE CURRENT SUBSET. ANY SUBSET WITH BYTE
12C> COUNT > 65530 WILL BE WRITTEN INTO ITS OWN ONE-SUBSET MESSAGE.
13C> IF THE CURRENT SUBSET IS LARGER THAN THE MAXIMUM MESSAGE LENGTH,
14C> THEN THE SUBSET IS DISCARDED AND A DIAGNOSTIC IS PRINTED.
15C>
16C> PROGRAM HISTORY LOG:
17C> 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
18C> 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
19C> "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
20C> ROUTINE "BORT"
21C> 1998-12-14 J. WOOLLEN -- NO LONGER CALLS BORT IF A SUBSET IS LARGER
22C> THAN A MESSAGE, JUST DISCARDS THE SUBSET
23C> 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
24C> OPENED AT ONE TIME INCREASED FROM 10 TO 32
25C> (NECESSARY IN ORDER TO PROCESS MULTIPLE
26C> BUFR FILES UNDER THE MPI)
27C> 2000-09-19 J. WOOLLEN -- MAXIMUM MESSAGE LENGTH INCREASED FROM
28C> 10,000 TO 20,000 BYTES
29C> 2003-11-04 J. ATOR -- ADDED DOCUMENTATION
30C> 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
31C> INTERDEPENDENCIES
32C> 2003-11-04 D. KEYSER -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
33C> DOCUMENTATION
34C> 2004-08-09 J. ATOR -- MAXIMUM MESSAGE LENGTH INCREASED FROM
35C> 20,000 TO 50,000 BYTES
36C> 2009-03-23 J. ATOR -- USE MSGFULL AND ERRWRT
37C> 2014-10-20 J. WOOLLEN -- ACCOUNT FOR SUBSETS WITH BYTE COUNT > 65530
38C> (THESE MUST BE WRITTEN INTO THEIR OWN
39C> ONE-SUBSET MESSAGE)
40C> 2014-10-20 D. KEYSER -- FOR CASE ABOVE, DO NOT WRITE "CURRENT"
41C> MESSAGE IF IT CONTAINS ZERO SUBSETS
42C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
43C> 2016-03-21 D. STOKES -- CALL USRTPL FOR OVERLARGE SUBSETS
44C>
45C> USAGE: CALL MSGUPD (LUNIT, LUN)
46C> INPUT ARGUMENT LIST:
47C> LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
48C> LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
49C> (ASSOCIATED WITH FILE CONNECTED TO LOGICAL UNIT LUNIT)
50C>
51C> REMARKS:
52C> THIS ROUTINE CALLS: ERRWRT IUPB MSGFULL MSGINI
53C> MSGWRT MVB PAD PKB
54C> USRTPL WRITLC
55C> THIS ROUTINE IS CALLED BY: WRITSA WRITSB
56C> Normally not called by any application
57C> programs.
58C>
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
72C-----------------------------------------------------------------------
73C-----------------------------------------------------------------------
74
75C PAD THE SUBSET BUFFER
76C ---------------------
77
78 CALL pad(ibay,ibit,ibyt,8)
79
80C CHECK WHETHER THE NEW SUBSET SHOULD BE WRITTEN INTO THE CURRENTLY
81C OPEN MESSAGE
82C -----------------------------------------------------------------
83
84 IF(msgfull(mbyt(lun),ibyt,maxbyt)
85 . .OR.
86 . ((ibyt.GT.65530).AND.(nsub(lun).GT.0))) THEN
87c NO it should not, either because:
88c 1) it doesn't fit,
89c -- OR --
90c 2) it has byte count > 65530 (sufficiently close to the
91c upper limit for the 16 bit byte counter placed at the
92c beginning of each subset), AND the current message has
93c at least one subset in it,
94c SO write the current message out and create a new one to
95c 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
101c This is an overlarge subset that won't fit in any message
102c given the current value of MAXBYT, so discard the subset
103c 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
117C SET A BYTE COUNT AND TRANSFER THE SUBSET BUFFER INTO THE MESSAGE
118C ----------------------------------------------------------------
119
120 lbit = 0
121 CALL pkb(ibyt,16,ibay,lbit)
122
123C Note that we want to append the data for this subset to the end
124C of Section 4, but the value in MBYT(LUN) already includes the
125C length of Section 5 (i.e. 4 bytes). Therefore, we need to begin
126C writing at the point 3 bytes prior to the byte currently pointed
127C to by MBYT(LUN).
128
129 CALL mvb(ibay,1,mbay(1,lun),mbyt(lun)-3,ibyt)
130
131C UPDATE THE SUBSET AND BYTE COUNTERS
132C --------------------------------------
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
145C IF ANY LONG CHARACTER STRINGS ARE BEING HELD INTERNALLY FOR STORAGE
146C INTO THIS SUBSET, STORE THEM NOW.
147C -------------------------------------------------------------------
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
156C IF THE SUBSET BYTE COUNT IS > 65530, THEN GIVE IT ITS OWN ONE-SUBSET
157C MESSAGE (CANNOT HAVE ANY OTHER SUBSETS IN THIS MESSAGE BECAUSE THEIR
158C BEGINNING WOULD BE BEYOND THE UPPER LIMIT OF 65535 IN THE 16-BIT
159C BYTE COUNTER, MEANING THEY COULD NOT BE LOCATED!)
160C --------------------------------------------------------------------
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
177C RESET THE USER ARRAYS AND EXIT NORMALLY
178C ---------------------------------------
179
180100 CALL usrtpl(lun,1,1)
181
182C EXIT
183C ----
184
185 RETURN
186 END
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
Definition: errwrt.f:42
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:37
subroutine msgini(LUN)
THIS SUBROUTINE INITIALIZES, WITHIN THE INTERNAL ARRAYS, A NEW BUFR MESSAGE FOR OUTPUT.
Definition: msgini.f:58
subroutine msgupd(LUNIT, LUN)
THIS SUBROUTINE PACKS UP THE CURRENT SUBSET WITHIN MEMORY (ARRAY IBAY IN MODULE BITBUF) AND THEN TRIE...
Definition: msgupd.f:60
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:55
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:44
This module contains array and variable declarations used to store BUFR messages internally for multi...
Definition: moda_bitbuf.F:10
integer maxbyt
Maximum length of an output BUFR message.
Definition: moda_bitbuf.F:22
integer, dimension(:), allocatable mbyt
Length (in bytes) of current BUFR message for each internal I/O stream.
Definition: moda_bitbuf.F:25
integer, dimension(:,:), allocatable mbay
Current BUFR message for each internal I/O stream.
Definition: moda_bitbuf.F:26
subroutine pad(IBAY, IBIT, IBYT, IPADB)
THIS SUBROUTINE FIRST PACKS THE VALUE FOR THE NUMBER OF BITS BEING "PADDED" (WE'LL GET TO THAT LATER)...
Definition: pad.f:53
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:39
subroutine usrtpl(LUN, INVN, NBMP)
THIS SUBROUTINE STORES THE SUBSET TEMPLATE INTO INTERNAL SUBSET ARRAYS IN MODULE USRINT FOR CASES OF ...
Definition: usrtpl.f:52
subroutine writlc(LUNIT, CHR, STR)
This subroutine writes a long character string (greater than 8 bytes) to a data subset.
Definition: writlc.f:60