NCEPLIBS-bufr  11.5.0
 All Data Structures Files Functions Variables Pages
ufbrep.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Read/write one or more data values from/to a data subset.
3 
4 C> This subroutine reads or writes one or more data values from or to
5 C> the BUFR data subset that is currently open within the BUFRLIB
6 C> internal arrays. The direction of the data transfer is determined
7 C> by the context of ABS(LUNIN):
8 C> - If ABS(LUNIN) points to a file that was previously opened for
9 C> input using subroutine openbf(), then data values are read from
10 C> the current data subset.
11 C> - If ABS(LUNIN) points to a file that was previously opened for
12 C> output using subroutine openbf(), then data values are written to
13 C> the current data subset.
14 C>
15 C> <p>This subroutine is specifically designed for use with Table B
16 C> mnemonics which are part of a fixed (i.e. non-delayed) replication
17 C> sequence, or for mnemonics which are replicated by being directly
18 C> listed more than once within an overall subset definition.
19 C> See also subroutines ufbint(),
20 C> ufbseq() and ufbstp(), which can also be used to read/write one or
21 C> more data values from/to a data subset but are designed for
22 C> different use cases. A more detailed discussion of
23 C> these different use cases, including examples, is available in
24 C> [DX BUFR Tables](@ref ufbsubs).
25 C>
26 C> @author J. Woollen
27 C> @date 1994-01-06
28 C>
29 C> @param[in] LUNIN - integer: Absolute value is Fortran logical
30 C> unit number for BUFR file
31 C> @param[in,out] USR - real*8(*,*): Data values
32 C> - If ABS(LUNIN) was opened for input, then
33 C> USR is output from this subroutine and
34 C> contains data values that were read
35 C> from the current data subset.
36 C> - If ABS(LUNIN) was opened for output, then
37 C> USR is input to this subroutine and
38 C> contains data values that are to be
39 C> written to the current data subset.
40 C> @param[in] I1 - integer: Actual first dimension of USR as allocated
41 C> within the calling program
42 C> @param[in] I2 - integer:
43 C> - If ABS(LUNIN) was opened for input, then I2
44 C> must be set equal to the actual second dimension
45 C> of USR as allocated within the calling program
46 C> - If ABS(LUNIN) was opened for output, then I2
47 C> must be set equal to the number of replications
48 C> of STR that are to be written to the data subset
49 C> @param[out] IRET - integer: Number of replications of STR that were
50 C> actually read/written from/to the data subset
51 C> @param[in] STR - character*(*): String of blank-separated
52 C> Table B mnemonics
53 C> in one-to-one correspondence with the number of data
54 C> values that will be read/written from/to the data
55 C> subset within the first dimension of USR (see
56 C> [DX BUFR Tables](@ref dfbftab) for further
57 C> information about Table B mnemonics)
58 C>
59 C> <p>It is the user's responsibility to ensure that USR is dimensioned
60 C> sufficiently large enough to accommodate the number of data values
61 C> that are to be read from or written to the data subset. Note also
62 C> that USR is an array of real*8 values; therefore, any data that are
63 C> to be written out as character (i.e. CCITT IA5) values in
64 C> BUFR must be converted from character into real*8 format within the
65 C> application program before calling this subroutine. Conversely,
66 C> when this subroutine is being used to read character values from a
67 C> data subset, the value that is returned will be in real*8 format
68 C> and must be converted back into character format by the application
69 C> program before it can be used as such. Alternatively, there are
70 C> different subroutines such as readlc() and writlc() which can be
71 C> used to read/write character data directly from/to a data subset
72 C> without the need to convert from/to real*8 format as an intermediate
73 C> step.
74 C>
75 C> <p>Numeric (i.e. non-character) data values within USR are always in
76 C> the exact units specified for the corresponding mnemonic within the
77 C> relevant DX or master BUFR table, without any scale or reference
78 C> values applied. Specifically, this means that, when writing
79 C> data values into an output subset, the user only needs to store each
80 C> respective value into USR using the units specified within the table,
81 C> and the BUFRLIB software will take care of any necessary scaling or
82 C> referencing of the value before it is actually encoded into BUFR.
83 C> Conversely, when reading data values from an input subset, the
84 C> values returned in USR are already de-scaled and de-referenced and,
85 C> thus, are already in the exact units that were defined for the
86 C> corresponding mnemonics within the table.
87 C>
88 C> <p>"Missing" values in USR are always denoted by a unique
89 C> placeholder value. This placeholder value is initially set
90 C> to a default value of 10E10_8, but it can be reset to
91 C> any substitute value of the user's choice via a separate
92 C> call to subroutine setbmiss(). In any case, and whenever this
93 C> subroutine is used to read data values from an input subset, any
94 C> returned value in USR can be easily checked for equivalence to the
95 C> current placeholder value via a call to function ibfms(), and a
96 C> positive result means that the value for the corresponding mnemonic
97 C> was encoded as "missing" in BUFR (i.e. all bits set to 1) within the
98 C> original data subset. Conversely, whenever this subroutine
99 C> is used to write data values to an output subset, the current
100 C> placeholder value can be obtained via a separate call to function
101 C> getbmiss(), and the resulting value can then be stored into the
102 C> USR array whereever the user desires a BUFR "missing" value (i.e.
103 C> all bits set to 1) to be encoded for the corresponding mnemonic
104 C> within the output subset.
105 C>
106 C> @remarks
107 C> - If LUNIN < 0, and if ABS(LUNIN) points to a file that is open
108 C> for output (writing BUFR), then the subroutine will treat the file
109 C> pointed to by ABS(LUNIN) as though it was open for input (reading
110 C> BUFR). This is a special capability for use by some applications
111 C> that need to read certain values back out from a BUFR file during
112 C> the same time that it is in the process of being written to.
113 C> - If ABS(LUNIN) points to a file that is open for input (reading
114 C> BUFR), there are a few additional special mnemonics that can be
115 C> included within STR when calling this subroutine, and which in turn
116 C> will result in special information being returned within the
117 C> corresponding location in USR. These special mnemonics are not
118 C> considered to be part of Table B or Table D and therefore do not
119 C> need to be definied within the DX or master table file associated
120 C> with ABS(LUNIN):
121 C> - NUL - returns the "missing" value
122 C> - IREC - returns the number of the BUFR message within the
123 C> file pointed to by ABS(LUNIN) (counting from the
124 C> beginning of the file) in which the current data
125 C> subset resides
126 C> - ISUB - returns the number of the current data subset within
127 C> the BUFR message pointed to by IREC, counting from
128 C> the beginning of the message
129 C>
130 C> <b>Program history log:</b>
131 C> - 1994-01-06 J. Woollen -- Original author
132 C> - 1998-07-08 J. Woollen -- Replaced call to Cray library routine ABORT
133 C> with call to new internal routine bort()
134 C> - 1999-11-18 J. Woollen -- The number of BUFR files which can be
135 C> opened at one time increased from 10 to C32
136 C> (necessary in order to process multiple
137 C> BUFR files under the MPI)
138 C> - 2003-05-19 J. Woollen -- Disabled the parsing switch which controls
139 C> checking for in the same replication group,
140 C> ufbrep does not need this check, and it
141 C> interferes with what ufbrep can do otherwise
142 C> - 2003-11-04 S. Bender -- Added remarks and routine interdependencies
143 C> - 2003-11-04 D. Keyser -- Unified/portable for WRF; added history
144 C> documentation; outputs more complete
145 C> diagnostic info when routine terminates
146 C> abnormally, unusual things happen or for
147 C> informational purposes
148 C> - 2004-08-18 J. Ator -- Added SAVE for IFIRST1 and IFIRST2 flags
149 C> - 2009-03-31 J. Woollen -- Add documentation
150 C> - 2009-04-21 J. Ator -- Use errwrt()
151 C> - 2014-12-10 J. Ator -- Use modules instead of COMMON blocks
152 C>
153  SUBROUTINE ufbrep(LUNIN,USR,I1,I2,IRET,STR)
154 
155  USE modv_bmiss
156  USE moda_usrint
157  USE moda_msgcwd
158 
159  COMMON /acmode/ iac
160  COMMON /quiet / iprt
161 
162  CHARACTER*(*) str
163  CHARACTER*128 bort_str1,bort_str2,errstr
164  REAL*8 usr(i1,i2)
165 
166  DATA ifirst1/0/,ifirst2/0/
167 
168  SAVE ifirst1, ifirst2
169 
170 C----------------------------------------------------------------------
171 C----------------------------------------------------------------------
172 
173  iret = 0
174 
175 C CHECK THE FILE STATUS AND I-NODE
176 C --------------------------------
177 
178  lunit = abs(lunin)
179  CALL status(lunit,lun,il,im)
180  IF(il.EQ.0) goto 900
181  IF(im.EQ.0) goto 901
182  IF(inode(lun).NE.inv(1,lun)) goto 902
183 
184  io = min(max(0,il),1)
185  IF(lunin.NE.lunit) io = 0
186 
187  IF(i1.LE.0) THEN
188  IF(iprt.GE.0) THEN
189  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
190  errstr = .LE.'BUFRLIB: UFBREP - 3rd ARG. (INPUT) IS 0, ' //
191  . 'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
192  CALL errwrt(errstr)
193  CALL errwrt(str)
194  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
195  CALL errwrt(' ')
196  ENDIF
197  goto 100
198  ELSEIF(i2.LE.0) THEN
199  IF(iprt.EQ.-1) ifirst1 = 1
200  IF(io.EQ.0 .OR. ifirst1.EQ.0 .OR. iprt.GE.1) THEN
201  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
202  errstr = .LE.'BUFRLIB: UFBREP - 4th ARG. (INPUT) IS 0, ' //
203  . 'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
204  CALL errwrt(errstr)
205  CALL errwrt(str)
206  IF(iprt.EQ.0 .AND. io.EQ.1) THEN
207  errstr = 'Note: Only the first occurrence of this WARNING ' //
208  . 'message is printed, there may be more. To output all ' //
209  . 'such messages,'
210  CALL errwrt(errstr)
211  errstr = 'modify your application program to add ' //
212  . '"CALL OPENBF(0,''QUIET'',1)" prior to the first call ' //
213  . 'to a BUFRLIB routine.'
214  CALL errwrt(errstr)
215  ENDIF
216  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
217  CALL errwrt(' ')
218  ifirst1 = 1
219  ENDIF
220  goto 100
221  ENDIF
222 
223 C INITIALIZE USR ARRAY PRECEEDING AN INPUT OPERATION
224 C --------------------------------------------------
225 
226  IF(io.EQ.0) THEN
227  DO j=1,i2
228  DO i=1,i1
229  usr(i,j) = bmiss
230  ENDDO
231  ENDDO
232  ENDIF
233 
234 C PARSE OR RECALL THE INPUT STRING - READ/WRITE VALUES
235 C ----------------------------------------------------
236 
237  ia2 = iac
238  iac = 1
239  CALL string(str,lun,i1,io)
240 
241 C CALL THE MNEMONIC READER/WRITER
242 C -------------------------------
243 
244  CALL ufbrp(lun,usr,i1,i2,io,iret)
245  iac = ia2
246 
247  IF(io.EQ.1 .AND. iret.LT.i2) goto 903
248 
249  IF(iret.EQ.0) THEN
250  IF(io.EQ.0) THEN
251  IF(iprt.GE.1) THEN
252  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
253  errstr = 'BUFRLIB: UFBREP - NO SPECIFIED VALUES READ IN, ' //
254  . 'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
255  CALL errwrt(errstr)
256  CALL errwrt(str)
257  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
258  CALL errwrt(' ')
259  ENDIF
260  ELSE
261  IF(iprt.EQ.-1) ifirst2 = 1
262  IF(ifirst2.EQ.0 .OR. iprt.GE.1) THEN
263  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
264  errstr = 'BUFRLIB: UFBREP - NO SPECIFIED VALUES WRITTEN OUT, ' //
265  . 'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
266  CALL errwrt(errstr)
267  CALL errwrt(str)
268  CALL errwrt('MAY NOT BE IN THE BUFR TABLE(?)')
269  IF(iprt.EQ.0) THEN
270  errstr = 'Note: Only the first occurrence of this WARNING ' //
271  . 'message is printed, there may be more. To output all ' //
272  . 'such messages,'
273  CALL errwrt(errstr)
274  errstr = 'modify your application program to add ' //
275  . '"CALL OPENBF(0,''QUIET'',1)" prior to the first call ' //
276  . 'to a BUFRLIB routine.'
277  CALL errwrt(errstr)
278  ENDIF
279  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
280  CALL errwrt(' ')
281  ifirst2 = 1
282  ENDIF
283  ENDIF
284  ENDIF
285 
286 C EXITS
287 C -----
288 
289 100 RETURN
290 900 CALL bort('BUFRLIB: UFBREP - BUFR FILE IS CLOSED, IT MUST BE'//
291  . ' OPEN')
292 901 CALL bort('BUFRLIB: UFBREP - A MESSAGE MUST BE OPEN IN BUFR '//
293  . 'FILE, NONE ARE')
294 902 CALL bort('BUFRLIB: UFBREP - LOCATION OF INTERNAL TABLE FOR '//
295  . 'BUFR FILE DOES NOT AGREE WITH EXPECTED LOCATION IN INTERNAL '//
296  . 'SUBSET ARRAY')
297 903 WRITE(bort_str1,'("BUFRLIB: UFBREP - MNEMONIC STRING READ IN IS'//
298  . ': ",A)') str
299  WRITE(bort_str2,'(18X,"THE NUMBER OF ''LEVELS'' ACTUALLY '//
300  . 'WRITTEN (",I3,") LESS THAN THE NUMBER REQUESTED (",I3,") - '//
301  . 'INCOMPLETE WRITE")') iret,i2
302  CALL bort2(bort_str1,bort_str2)
303  END
subroutine ufbrep(LUNIN, USR, I1, I2, IRET, STR)
This subroutine reads or writes one or more data values from or to the BUFR data subset that is curre...
Definition: ufbrep.f:153
subroutine bort2(STR1, STR2)
This subroutine calls subroutine errwrt() to log two error messages, then calls subroutine bort_exit(...
Definition: bort2.f:20
This module declares and initializes the BMISS variable.
Definition: modv_BMISS.f90:9
subroutine string(STR, LUN, I1, IO)
THIS SUBROUTINE CHECKS TO SEE IF A USER-SPECIFIED CHARACTER STRING IS IN THE STRING CACHE (ARRAYS IN ...
Definition: string.f:58
subroutine ufbrp(LUN, USR, I1, I2, IO, IRET)
THIS SUBROUTINE WRITES OR READS SPECIFIED VALUES TO OR FROM THE CURRENT BUFR DATA SUBSET WITHIN INTER...
Definition: ufbrp.f:69
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 errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
Definition: errwrt.f:39
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:23