NCEPLIBS-bufr  12.0.0
writsa.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Write a data subset into a BUFR message, and return each
3 C> completed message within a memory array.
4 C>
5 C> @author J. Woollen @author J. Ator @date 1994-01-06
6 
7 C> Write a data subset into a BUFR message, and return each
8 C> completed message within a memory array.
9 C>
10 C> This subroutine is similar to subroutine writsb(), except that in
11 C> addition to writing each completed message to a specified Fortran
12 C> logical unit, it also returns a copy of each completed message to
13 C> the application program within a memory array.
14 C>
15 C> This subroutine is called to indicate that
16 C> all necessary values for a data subset (i.e. report) have been written,
17 C> and the subset is ready to be encoded and packed into the
18 C> current message for the BUFR file associated with logical unit
19 C> ABS(LUNXX). Logical unit ABS(LUNXX) should have already been opened
20 C> for output operations via a previous call to subroutine openbf(),
21 C> and a BUFR message should already be open for output within internal
22 C> arrays via a previous call to one of the BUFRLIB
23 C> [message-writing subroutines](@ref hierarchy).
24 C> All of the values for the data subset should have
25 C> already been written into internal arrays via calls to any of the
26 C> BUFRLIB [values-writing subroutines](@ref hierarchy)
27 C>
28 C> This subroutine returns a copy of each completed
29 C> BUFR message to the application program within a memory array.
30 C> When using this subroutine, it is important to note that the BUFRLIB
31 C> software is designed to pack as many data subsets as possible into
32 C> each message for output, and therefore not every call to this
33 C> subroutine will result in a message being returned in MSGT. In
34 C> such cases, MSGL will contain the value 0, indicating that no
35 C> message was returned.
36 C>
37 C> Only when MSGL contains a value
38 C> greater than 0 is there an actual BUFR message within MSGT; otherwise,
39 C> the message into which the data subset was packed remains internally
40 C> within BUFRLIB so that future data subsets can be packed into it as
41 C> well, and the message will eventually be returned during some other
42 C> future call to this subroutine. For this reason, there is a way to
43 C> force the subroutine to return any message contained within the
44 C> internal BUFRLIB arrays, such as when there are no more data subsets
45 C> to be encoded and we're ready to exit the application program. In
46 C> this case, the application program should make one final call to
47 C> this subroutine, but with LUNXX set to a negative value;
48 C> specifically, to the additive inverse of the Fortran logical unit
49 C> number of the BUFR file. This signals to the subroutine that there
50 C> are no more data subsets to be packed into the current message for
51 C> logical unit ABS(LUNXX), and that the existing message should
52 C> instead be immediately flushed to output and returned in MSGT.
53 C>
54 C> @remarks
55 C> - There is a maximum size for any BUFR message that can be written
56 C> by the BUFRLIB software. This maximum message size is initially set
57 C> to an internal default value within subroutine bfrini(), but it can
58 C> be changed to a different value via a separate prior call to
59 C> subroutine maxout().
60 C> - As is the case for subroutine writsb(), this subroutine will also
61 C> check to ensure that the data subset, when encoded and packed, will
62 C> fit into the current BUFR message that is open within the internal
63 C> arrays associated with logical unit ABS(LUNXX). If adding the data
64 C> subset to the current message would cause the maximum message size
65 C> to be exceeded, then the subroutine will automatically flush the
66 C> current message to logical unit ABS(LUNXX) and to array MSGT, then
67 C> open and initialize a new internal message using the same SUBSET and
68 C> JDATE values that were specified in the most recent call to one of
69 C> the [message-writing subroutines](@ref hierarchy) for ABS(LUNXX),
70 C> then encode and pack the data subset into that new message.
71 C> - If the user would prefer that output messages only be returned
72 C> to the calling program via the MSGT memory array and not also
73 C> written to Fortran logical unit ABS(LUNXX), then this can be
74 C> accomplished by setting IO = 'NUL' when calling subroutine openbf()
75 C> for ABS(LUNXX). In such cases, the logical unit number ABS(LUNXX)
76 C> does not even need to be associated with an actual file on the
77 C> local system.
78 C>
79 C> @param[in] LUNXX - integer: Absolute value is Fortran logical unit
80 C> number for BUFR file.
81 C> @param[in] LMSGT - integer: Dimensioned size (in integers) of MSGT;
82 C> used by the subroutine to ensure that it doesn't overflow the MSGT
83 C> array.
84 C> @param[out] MSGT - integer: BUFR message.
85 C> @param[out] MSGL - integer: Size (in integers) of BUFR message in
86 C> MSGT (0 for no message).
87 C>
88 C> @author J. Woollen @author J. Ator @date 1994-01-06
89 
90  RECURSIVE SUBROUTINE writsa(LUNXX,LMSGT,MSGT,MSGL)
91 
92  USE modv_im8b
93 
94  USE moda_bufrmg
95 
96  COMMON /msgcmp/ ccmf
97 
98  CHARACTER*1 ccmf
99 
100  dimension msgt(*)
101 
102 C----------------------------------------------------------------------
103 C----------------------------------------------------------------------
104 
105 C CHECK FOR I8 INTEGERS
106 C ---------------------
107 
108  IF(im8b) THEN
109  im8b=.false.
110 
111  CALL x84 ( lunxx, my_lunxx, 1 )
112  CALL x84 ( lmsgt, my_lmsgt, 1 )
113  CALL writsa ( my_lunxx, my_lmsgt*2, msgt, msgl )
114  msgl = msgl/2
115  CALL x48 ( msgl, msgl, 1 )
116 
117  im8b=.true.
118  RETURN
119  ENDIF
120 
121  lunit = abs(lunxx)
122 
123 C CHECK THE FILE STATUS
124 C ---------------------
125 
126  CALL status(lunit,lun,il,im)
127  IF(il.EQ.0) GOTO 900
128  IF(il.LT.0) GOTO 901
129  IF(im.EQ.0) GOTO 902
130 
131 C IF LUNXX < 0, FORCE MEMORY MSG TO BE WRITTEN (W/O ANY CURRENT SUBSET)
132 C ---------------------------------------------------------------------
133 
134  IF(lunxx.LT.0) CALL closmg(lunit)
135 
136 C IS THERE A COMPLETED BUFR MESSAGE TO BE RETURNED?
137 C -------------------------------------------------
138 
139  IF(msglen(lun).GT.0) THEN
140  IF(msglen(lun).GT.lmsgt) GOTO 904
141  msgl = msglen(lun)
142  DO n=1,msgl
143  msgt(n) = msgtxt(n,lun)
144  ENDDO
145  msglen(lun) = 0
146  ELSE
147  msgl = 0
148  ENDIF
149 
150  IF(lunxx.LT.0) GOTO 100
151 
152 C PACK UP THE SUBSET AND PUT IT INTO THE MESSAGE
153 C ----------------------------------------------
154 
155  CALL wrtree(lun)
156  IF( ccmf.EQ.'Y' ) THEN
157  CALL wrcmps(lunit)
158  ELSE
159  CALL msgupd(lunit,lun)
160  ENDIF
161 
162 C IF THE JUST-COMPLETED CALL TO WRCMPS OR MSGUPD FOR THIS SUBSET CAUSED
163 C A MESSAGE TO BE FLUSHED TO ABS(LUNXX), THEN ATTEMPT TO RETRIEVE AND
164 C RETURN THAT MESSAGE NOW. OTHERWISE, WE RUN THE RISK THAT THE NEXT
165 C CALL TO OPENMB OR OPENMG MIGHT CAUSE ANOTHER MESSAGE TO BE FLUSHED,
166 C AND THUS OVERWRITE THE CURRENT MESSAGE WITHIN ARRAY MSGTXT BEFORE WE
167 C HAD THE CHANCE TO RETRIEVE IT DURING THE NEXT CALL TO WRITSA.
168 
169 C ALSO NOTE THAT, IN RARE INSTANCES (E.G. IF THE BYTE COUNT OF THE MOST
170 C RECENT SUBSET IS > 65530), WE COULD END UP WITH TWO BUFR MESSAGES
171 C AVAILABLE TO BE RETURNED FROM THIS ONE CALL TO WRITSA. IF SUFFICIENT
172 C SPACE IS AVAILABLE IN THE MSGT ARRAY, THEN GO AHEAD AND RETURN BOTH
173 C MESSAGES NOW.
174 
175  IF( (msglen(lun).GT.0) .AND. (msgl+msglen(lun).LE.lmsgt) ) THEN
176  DO n = 1,msglen(lun)
177  msgt(msgl+n) = msgtxt(n,lun)
178  ENDDO
179  msgl = msgl+msglen(lun)
180  msglen(lun) = 0
181  ENDIF
182 
183 C EXITS
184 C -----
185 
186 100 RETURN
187 900 CALL bort('BUFRLIB: WRITSA - OUTPUT BUFR FILE IS CLOSED, IT '//
188  . 'MUST BE OPEN FOR OUTPUT')
189 901 CALL bort('BUFRLIB: WRITSA - OUTPUT BUFR FILE IS OPEN FOR '//
190  . 'INPUT, IT MUST BE OPEN FOR OUTPUT')
191 902 CALL bort('BUFRLIB: WRITSA - A MESSAGE MUST BE OPEN IN OUTPUT '//
192  . 'BUFR FILE, NONE ARE')
193 904 CALL bort('BUFRLIB: WRITSA - OVERFLOW OF OUTPUT BUFR MESSAGE '//
194  . 'ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY')
195  END
subroutine bort(STR)
Log one error message and abort application program.
Definition: bort.f:18
recursive subroutine closmg(LUNIN)
This subroutine closes the BUFR message that is currently open for writing within internal arrays ass...
Definition: closmg.f:26
subroutine msgupd(LUNIT, LUN)
This subroutine packs up the current subset within memory (array ibay in module moda_bitbuf) and then...
Definition: msgupd.f:24
This module contains arrays used to store, for each output I/O stream, a copy of the BUFR message tha...
integer, dimension(:), allocatable msglen
Length (in integers) of BUFR message most recently written to each output I/O stream.
integer, dimension(:,:), allocatable msgtxt
BUFR message most recently written to each output I/O stream.
This module declares and initializes the IM8B variable.
logical, public im8b
Status indicator to keep track of whether all future calls to BUFRLIB subroutines and functions from ...
recursive subroutine status(LUNIT, LUN, IL, IM)
Check whether a specified Fortran logical unit number is currently connected to the NCEPLIBS-bufr sof...
Definition: status.f:36
subroutine wrcmps(LUNIX)
This subroutine packs up the current subset within memory (array ibay in module moda_bitbuf),...
Definition: wrcmps.f:23
recursive subroutine writsa(LUNXX, LMSGT, MSGT, MSGL)
Write a data subset into a BUFR message, and return each completed message within a memory array.
Definition: writsa.f:91
subroutine wrtree(LUN)
Pack a BUFR data subset.
Definition: wrtree.f:16
subroutine x48(IIN4, IOUT8, NVAL)
Encode one or more 4-byte integer values as 8-byte integer values.
Definition: x48.F:19
subroutine x84(IIN8, IOUT4, NVAL)
Encode one or more 8-byte integer values as 4-byte integer values.
Definition: x84.F:19