NCEPLIBS-bufr  11.7.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> | Date | Programmer | Comments |
132 C> | -----|------------|----------|
133 C> | 1994-01-06 | J. Woollen | Original author |
134 C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine ABORT with call to new internal routine bort() |
135 C> | 1999-11-18 | J. Woollen | The number of BUFR files which can be opened at one time increased from 10 to C32 |
136 C> | 2003-05-19 | J. Woollen | Disabled the parsing switch which controls checking in the same replication group |
137 C> | 2003-11-04 | S. Bender | Added remarks and routine interdependencies |
138 C> | 2003-11-04 | D. Keyser | Unified/portable for WRF; added documentation; outputs more complete diagnostic info when routine terminates abnormally |
139 C> | 2004-08-18 | J. Ator | Added SAVE for IFIRST1 and IFIRST2 flags |
140 C> | 2009-03-31 | J. Woollen | Add documentation |
141 C> | 2009-04-21 | J. Ator | Use errwrt() |
142 C> | 2014-12-10 | J. Ator | Use modules instead of COMMON blocks |
143 C>
144  SUBROUTINE ufbrep(LUNIN,USR,I1,I2,IRET,STR)
145 
146  USE modv_bmiss
147  USE moda_usrint
148  USE moda_msgcwd
149 
150  COMMON /acmode/ iac
151  COMMON /quiet / iprt
152 
153  CHARACTER*(*) str
154  CHARACTER*128 bort_str1,bort_str2,errstr
155  REAL*8 usr(i1,i2)
156 
157  DATA ifirst1/0/,ifirst2/0/
158 
159  SAVE ifirst1, ifirst2
160 
161 C----------------------------------------------------------------------
162 C----------------------------------------------------------------------
163 
164  iret = 0
165 
166 C CHECK THE FILE STATUS AND I-NODE
167 C --------------------------------
168 
169  lunit = abs(lunin)
170  CALL status(lunit,lun,il,im)
171  IF(il.EQ.0) goto 900
172  IF(im.EQ.0) goto 901
173  IF(inode(lun).NE.inv(1,lun)) goto 902
174 
175  io = min(max(0,il),1)
176  IF(lunin.NE.lunit) io = 0
177 
178  IF(i1.LE.0) THEN
179  IF(iprt.GE.0) THEN
180  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
181  errstr = .LE.'BUFRLIB: UFBREP - 3rd ARG. (INPUT) IS 0, ' //
182  . 'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
183  CALL errwrt(errstr)
184  CALL errwrt(str)
185  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
186  CALL errwrt(' ')
187  ENDIF
188  goto 100
189  ELSEIF(i2.LE.0) THEN
190  IF(iprt.EQ.-1) ifirst1 = 1
191  IF(io.EQ.0 .OR. ifirst1.EQ.0 .OR. iprt.GE.1) THEN
192  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
193  errstr = .LE.'BUFRLIB: UFBREP - 4th ARG. (INPUT) IS 0, ' //
194  . 'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
195  CALL errwrt(errstr)
196  CALL errwrt(str)
197  IF(iprt.EQ.0 .AND. io.EQ.1) THEN
198  errstr = 'Note: Only the first occurrence of this WARNING ' //
199  . 'message is printed, there may be more. To output all ' //
200  . 'such messages,'
201  CALL errwrt(errstr)
202  errstr = 'modify your application program to add ' //
203  . '"CALL OPENBF(0,''QUIET'',1)" prior to the first call ' //
204  . 'to a BUFRLIB routine.'
205  CALL errwrt(errstr)
206  ENDIF
207  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
208  CALL errwrt(' ')
209  ifirst1 = 1
210  ENDIF
211  goto 100
212  ENDIF
213 
214 C INITIALIZE USR ARRAY PRECEEDING AN INPUT OPERATION
215 C --------------------------------------------------
216 
217  IF(io.EQ.0) THEN
218  DO j=1,i2
219  DO i=1,i1
220  usr(i,j) = bmiss
221  ENDDO
222  ENDDO
223  ENDIF
224 
225 C PARSE OR RECALL THE INPUT STRING - READ/WRITE VALUES
226 C ----------------------------------------------------
227 
228  ia2 = iac
229  iac = 1
230  CALL string(str,lun,i1,io)
231 
232 C CALL THE MNEMONIC READER/WRITER
233 C -------------------------------
234 
235  CALL ufbrp(lun,usr,i1,i2,io,iret)
236  iac = ia2
237 
238  IF(io.EQ.1 .AND. iret.LT.i2) goto 903
239 
240  IF(iret.EQ.0) THEN
241  IF(io.EQ.0) THEN
242  IF(iprt.GE.1) THEN
243  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
244  errstr = 'BUFRLIB: UFBREP - NO SPECIFIED VALUES READ IN, ' //
245  . 'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
246  CALL errwrt(errstr)
247  CALL errwrt(str)
248  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
249  CALL errwrt(' ')
250  ENDIF
251  ELSE
252  IF(iprt.EQ.-1) ifirst2 = 1
253  IF(ifirst2.EQ.0 .OR. iprt.GE.1) THEN
254  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
255  errstr = 'BUFRLIB: UFBREP - NO SPECIFIED VALUES WRITTEN OUT, ' //
256  . 'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
257  CALL errwrt(errstr)
258  CALL errwrt(str)
259  CALL errwrt('MAY NOT BE IN THE BUFR TABLE(?)')
260  IF(iprt.EQ.0) THEN
261  errstr = 'Note: Only the first occurrence of this WARNING ' //
262  . 'message is printed, there may be more. To output all ' //
263  . 'such messages,'
264  CALL errwrt(errstr)
265  errstr = 'modify your application program to add ' //
266  . '"CALL OPENBF(0,''QUIET'',1)" prior to the first call ' //
267  . 'to a BUFRLIB routine.'
268  CALL errwrt(errstr)
269  ENDIF
270  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
271  CALL errwrt(' ')
272  ifirst2 = 1
273  ENDIF
274  ENDIF
275  ENDIF
276 
277 C EXITS
278 C -----
279 
280 100 RETURN
281 900 CALL bort('BUFRLIB: UFBREP - BUFR FILE IS CLOSED, IT MUST BE'//
282  . ' OPEN')
283 901 CALL bort('BUFRLIB: UFBREP - A MESSAGE MUST BE OPEN IN BUFR '//
284  . 'FILE, NONE ARE')
285 902 CALL bort('BUFRLIB: UFBREP - LOCATION OF INTERNAL TABLE FOR '//
286  . 'BUFR FILE DOES NOT AGREE WITH EXPECTED LOCATION IN INTERNAL '//
287  . 'SUBSET ARRAY')
288 903 WRITE(bort_str1,'("BUFRLIB: UFBREP - MNEMONIC STRING READ IN IS'//
289  . ': ",A)') str
290  WRITE(bort_str2,'(18X,"THE NUMBER OF ''LEVELS'' ACTUALLY '//
291  . 'WRITTEN (",I3,") LESS THAN THE NUMBER REQUESTED (",I3,") - '//
292  . 'INCOMPLETE WRITE")') iret,i2
293  CALL bort2(bort_str1,bort_str2)
294  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:144
subroutine bort2(STR1, STR2)
This subroutine calls subroutine errwrt() to log two error messages, then calls subroutine bort_exit(...
Definition: bort2.f:22
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:55
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 bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22