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