NCEPLIBS-bufr  12.0.0
ufbint.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 C>
4 C> @author J. Woollen @date 1994-01-06
5 
6 C> Read/write one or more data values from/to a data subset.
7 C>
8 C> This subroutine reads or writes one or more data values from or to
9 C> the BUFR data subset that is currently open within the BUFRLIB
10 C> internal arrays. The direction of the data transfer is determined
11 C> by the context of ABS(LUNIN):
12 C> - If ABS(LUNIN) points to a file that was previously opened for
13 C> input using subroutine openbf(), then data values are read from
14 C> the current data subset.
15 C> - If ABS(LUNIN) points to a file that was previously opened for
16 C> output using subroutine openbf(), then data values are written to
17 C> the current data subset.
18 C>
19 C> This subroutine is specifically designed for use with Table B
20 C> mnemonics which are part of a delayed-replication sequence, or for
21 C> which there is no replication at all. See also subroutines ufbrep(),
22 C> ufbseq() and ufbstp(), which can also be used to read/write one or
23 C> more data values from/to a data subset but are designed for
24 C> different use cases. A more detailed discussion of
25 C> these different use cases, including examples, is available in
26 C> [DX BUFR Tables](@ref ufbsubs).
27 C>
28 C> It is the user's responsibility to ensure that USR is dimensioned
29 C> sufficiently large enough to accommodate the number of data values
30 C> that are to be read from or written to the data subset. Note also
31 C> that USR is an array of real*8 values; therefore, any data that are
32 C> to be written out as character (i.e. CCITT IA5) values in
33 C> BUFR must be converted from character into real*8 format within the
34 C> application program before calling this subroutine. Conversely,
35 C> when this subroutine is being used to read character values from a
36 C> data subset, the value that is returned will be in real*8 format
37 C> and must be converted back into character format by the application
38 C> program before it can be used as such. Alternatively, there are
39 C> different subroutines such as readlc() and writlc() which can be
40 C> used to read/write character data directly from/to a data subset
41 C> without the need to convert from/to real*8 format as an intermediate
42 C> step.
43 C>
44 C> Numeric (i.e. non-character) data values within USR are always in
45 C> the exact units specified for the corresponding mnemonic within the
46 C> relevant DX or master BUFR table, without any scale or reference
47 C> values applied. Specifically, this means that, when writing
48 C> data values into an output subset, the user only needs to store each
49 C> respective value into USR using the units specified within the table,
50 C> and the BUFRLIB software will take care of any necessary scaling or
51 C> referencing of the value before it is actually encoded into BUFR.
52 C> Conversely, when reading data values from an input subset, the
53 C> values returned in USR are already de-scaled and de-referenced and,
54 C> thus, are already in the exact units that were defined for the
55 C> corresponding mnemonics within the table.
56 C>
57 C> "Missing" values in USR are always denoted by a unique
58 C> placeholder value. This placeholder value is initially set
59 C> to a default value of 10E10_8, but it can be reset to
60 C> any substitute value of the user's choice via a separate
61 C> call to subroutine setbmiss(). In any case, and whenever this
62 C> subroutine is used to read data values from an input subset, any
63 C> returned value in USR can be easily checked for equivalence to the
64 C> current placeholder value via a call to function ibfms(), and a
65 C> positive result means that the value for the corresponding mnemonic
66 C> was encoded as "missing" in BUFR (i.e. all bits set to 1) within the
67 C> original data subset. Conversely, whenever this subroutine
68 C> is used to write data values to an output subset, the current
69 C> placeholder value can be obtained via a separate call to function
70 C> getbmiss(), and the resulting value can then be stored into the
71 C> USR array whereever the user desires a BUFR "missing" value (i.e.
72 C> all bits set to 1) to be encoded for the corresponding mnemonic
73 C> within the output subset.
74 C>
75 C> @remarks
76 C> - If LUNIN < 0, and if ABS(LUNIN) points to a file that is open
77 C> for output (writing BUFR), then the subroutine will treat the file
78 C> pointed to by ABS(LUNIN) as though it was open for input (reading
79 C> BUFR). This is a special capability for use by some applications
80 C> that need to read certain values back out from a BUFR file during
81 C> the same time that it is in the process of being written to.
82 C> - If ABS(LUNIN) points to a file that is open for input (reading
83 C> BUFR), STR may contain a Table D mnemonic that is replicated using
84 C> either 8-bit or 16-bit delayed replication (as noted using
85 C> replication indicators {} or (), respectively, within the
86 C> assocated DX BUFR table), and the corresponding location in USR
87 C> will contain the total number of replications of that mnemonic
88 C> within the data subset. Note that, when using this option, the
89 C> applicable replication indicators must be included in STR
90 C> along with the mnemonic itself, as shown in an example in the
91 C> discussion of [DX BUFR Tables](@ref ufbsubs).
92 C>
93 C> @param[in] LUNIN - integer: Absolute value is Fortran logical
94 C> unit number for BUFR file.
95 C> @param[in,out] USR - real*8(*,*): Data values
96 C> - If ABS(LUNIN) was opened for input, then USR is output from this subroutine and
97 C> contains data values that were read from the current data subset.
98 C> - If ABS(LUNIN) was opened for output, then USR is input to this subroutine and
99 C> contains data values that are to be written to the current data subset.
100 C> @param[in] I1 - integer: First dimension of USR as allocated
101 C> within the calling program.
102 C> @param[in] I2 - integer:
103 C> - If ABS(LUNIN) was opened for input, then I2
104 C> must be set equal to the second dimension
105 C> of USR as allocated within the calling program
106 C> - If ABS(LUNIN) was opened for output, then I2
107 C> must be set equal to the number of replications
108 C> of STR that are to be written to the data subset
109 C> @param[out] IRET - integer: Number of replications of STR that were
110 C> read/written from/to the data subset
111 C> @param[in] STR - character*(*): String of blank-separated
112 C> Table B mnemonics in one-to-one correspondence with the number of data
113 C> values that will be read/written from/to the data
114 C> subset within the first dimension of USR (see
115 C> [DX BUFR Tables](@ref dfbftab) for further
116 C> information about Table B mnemonics)
117 C>
118 C> @author J. Woollen @date 1994-01-06
119 
120  RECURSIVE SUBROUTINE ufbint(LUNIN,USR,I1,I2,IRET,STR)
121 
122  USE modv_im8b
123  USE modv_bmiss
124 
125  USE moda_usrint
126  USE moda_msgcwd
127 
128  COMMON /usrstr/ nnod,ncon,nods(20),nodc(10),ivls(10),kons(10)
129  COMMON /quiet / iprt
130 
131  CHARACTER*(*) str
132  CHARACTER*128 bort_str1,bort_str2,errstr
133  real*8 usr(i1,i2)
134 
135  DATA ifirst1/0/,ifirst2/0/
136 
137  SAVE ifirst1, ifirst2
138 
139 C----------------------------------------------------------------------
140 C----------------------------------------------------------------------
141 
142 C CHECK FOR I8 INTEGERS
143 C ---------------------
144 
145  IF(im8b) THEN
146  im8b=.false.
147 
148  CALL x84(lunin,my_lunin,1)
149  CALL x84(i1,my_i1,1)
150  CALL x84(i2,my_i2,1)
151  CALL ufbint(my_lunin,usr,my_i1,my_i2,iret,str)
152  CALL x48(iret,iret,1)
153 
154  im8b=.true.
155  RETURN
156  ENDIF
157 
158  iret = 0
159 
160 C CHECK THE FILE STATUS AND I-NODE
161 C --------------------------------
162 
163  lunit = abs(lunin)
164  CALL status(lunit,lun,il,im)
165  IF(il.EQ.0) GOTO 900
166  IF(im.EQ.0) GOTO 901
167  IF(inode(lun).NE.inv(1,lun)) GOTO 902
168 
169  io = min(max(0,il),1)
170  IF(lunit.NE.lunin) io = 0
171 
172  IF(i1.LE.0) THEN
173  IF(iprt.GE.0) THEN
174  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
175  errstr = .LE.'BUFRLIB: UFBINT - 3rd ARG. (INPUT) IS 0, ' //
176  . 'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
177  CALL errwrt(errstr)
178  CALL errwrt(str)
179  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
180  CALL errwrt(' ')
181  ENDIF
182  GOTO 100
183  ELSEIF(i2.LE.0) THEN
184  IF(iprt.EQ.-1) ifirst1 = 1
185  IF(io.EQ.0 .OR. ifirst1.EQ.0 .OR. iprt.GE.1) THEN
186  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
187  errstr = .LE.'BUFRLIB: UFBINT - 4th ARG. (INPUT) IS 0, ' //
188  . 'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
189  CALL errwrt(errstr)
190  CALL errwrt(str)
191  IF(iprt.EQ.0 .AND. io.EQ.1) THEN
192  errstr = 'Note: Only the first occurrence of this WARNING ' //
193  . 'message is printed, there may be more. To output all ' //
194  . 'such messages,'
195  CALL errwrt(errstr)
196  errstr = 'modify your application program to add ' //
197  . '"CALL OPENBF(0,''QUIET'',1)" prior to the first call ' //
198  . 'to a BUFRLIB routine.'
199  CALL errwrt(errstr)
200  ENDIF
201  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
202  CALL errwrt(' ')
203  ifirst1 = 1
204  ENDIF
205  GOTO 100
206  ENDIF
207 
208 C PARSE OR RECALL THE INPUT STRING
209 C --------------------------------
210 
211  CALL string(str,lun,i1,io)
212 
213 C INITIALIZE USR ARRAY PRECEEDING AN INPUT OPERATION
214 C --------------------------------------------------
215 
216  IF(io.EQ.0) THEN
217  DO j=1,i2
218  DO i=1,i1
219  usr(i,j) = bmiss
220  ENDDO
221  ENDDO
222  ENDIF
223 
224 C CALL THE MNEMONIC READER/WRITER
225 C -------------------------------
226 
227  CALL ufbrw(lun,usr,i1,i2,io,iret)
228 
229 C IF INCOMPLETE WRITE TRY TO INITIALIZE REPLICATION SEQUENCE OR RETURN
230 C ---------------------------------------------------------------------
231 
232  IF(io.EQ.1 .AND. iret.NE.i2 .AND. iret.GE.0) THEN
233  CALL trybump(lun,usr,i1,i2,io,iret)
234  IF(iret.NE.i2) GOTO 903
235  ELSEIF(iret.EQ.-1) THEN
236  iret = 0
237  ENDIF
238 
239  IF(iret.EQ.0) THEN
240  IF(io.EQ.0) THEN
241  IF(iprt.GE.1) THEN
242  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
243  errstr = 'BUFRLIB: UFBINT - NO SPECIFIED VALUES READ IN, ' //
244  . 'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
245  CALL errwrt(errstr)
246  CALL errwrt(str)
247  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
248  CALL errwrt(' ')
249  ENDIF
250  ELSE
251  IF(iprt.EQ.-1) ifirst2 = 1
252  IF(ifirst2.EQ.0 .OR. iprt.GE.1) THEN
253  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
254  errstr = 'BUFRLIB: UFBINT - NO SPECIFIED VALUES WRITTEN OUT, ' //
255  . 'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
256  CALL errwrt(errstr)
257  CALL errwrt(str)
258  CALL errwrt('MAY NOT BE IN THE BUFR TABLE(?)')
259  IF(iprt.EQ.0) THEN
260  errstr = 'Note: Only the first occurrence of this WARNING ' //
261  . 'message is printed, there may be more. To output all ' //
262  . 'such messages,'
263  CALL errwrt(errstr)
264  errstr = 'modify your application program to add ' //
265  . '"CALL OPENBF(0,''QUIET'',1)" prior to the first call ' //
266  . 'to a BUFRLIB routine.'
267  CALL errwrt(errstr)
268  ENDIF
269  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
270  CALL errwrt(' ')
271  ifirst2 = 1
272  ENDIF
273  ENDIF
274  ENDIF
275 
276 C EXITS
277 C -----
278 
279 100 RETURN
280 900 CALL bort('BUFRLIB: UFBINT - BUFR FILE IS CLOSED, IT MUST BE'//
281  . ' OPEN')
282 901 CALL bort('BUFRLIB: UFBINT - A MESSAGE MUST BE OPEN IN BUFR '//
283  . 'FILE, NONE ARE')
284 902 CALL bort('BUFRLIB: UFBINT - LOCATION OF INTERNAL TABLE FOR '//
285  . 'BUFR FILE DOES NOT AGREE WITH EXPECTED LOCATION IN INTERNAL '//
286  . 'SUBSET ARRAY')
287 903 WRITE(bort_str1,'("BUFRLIB: UFBINT - MNEMONIC STRING READ IN IS'//
288  . ': ",A)') str
289  WRITE(bort_str2,'(18X,"THE NUMBER OF ''LEVELS'' ACTUALLY '//
290  . 'WRITTEN (",I3,") DOES NOT EQUAL THE NUMBER REQUESTED (",I3,")'//
291  . ' - INCOMPLETE WRITE")') iret,i2
292  CALL bort2(bort_str1,bort_str2)
293  END
subroutine bort2(STR1, STR2)
Log two error messages and abort application program.
Definition: bort2.f:18
subroutine bort(STR)
Log one error message and abort application program.
Definition: bort.f:18
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
Definition: errwrt.f:36
This module contains declarations for arrays used to store information about the current BUFR message...
integer, dimension(:), allocatable inode
Table A mnemonic for type of BUFR message.
This module contains declarations for arrays used to store data values and associated metadata for th...
integer, dimension(:,:), allocatable, target inv
Inventory pointer which links each data value to its corresponding node in the internal jump/link tab...
This module declares and initializes the BMISS variable.
Definition: modules_vars.F90:9
real *8, public bmiss
Current placeholder value to represent "missing" data when reading from or writing to BUFR files; thi...
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 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:28
subroutine trybump(LUN, USR, I1, I2, IO, IRET)
This subroutine checks the first node associated with a character string (parsed into arrays in commo...
Definition: trybump.f:38
recursive subroutine ufbint(LUNIN, USR, I1, I2, IRET, STR)
Read/write one or more data values from/to a data subset.
Definition: ufbint.f:121
subroutine ufbrw(LUN, USR, I1, I2, IO, IRET)
This subroutine writes or reads specified values to or from the current BUFR data subset within inter...
Definition: ufbrw.f:32
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