| blob | 9e0bcdfd17430f67b0cb4a695b00bd77ab827bfa |
1 SUBROUTINE UFBINT(LUNIN,USR,I1,I2,IRET,STR)
3 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
4 !
5 ! SUBPROGRAM: UFBINT
6 ! PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06
7 !
8 ! ABSTRACT: THIS SUBROUTINE WRITES OR READS SPECIFIED VALUES TO OR FROM
9 ! THE CURRENT BUFR DATA SUBSET WITHIN INTERNAL ARRAYS, WITH THE
10 ! DIRECTION OF THE DATA TRANSFER DETERMINED BY THE CONTEXT OF
11 ! ABS(LUNIN) {I.E., IF ABS(LUNIN) POINTS TO A BUFR FILE THAT IS OPEN
12 ! FOR INPUT, THEN DATA VALUES ARE READ FROM THE INTERNAL DATA SUBSET;
13 ! OTHERWISE, DATA VALUES ARE WRITTEN TO THE INTERNAL DATA SUBSET}.
14 ! THE DATA VALUES CORRESPOND TO MNEMONICS WHICH ARE PART OF A
15 ! DELAYED-REPLICATION SEQUENCE, OR FOR WHICH THERE IS NO REPLICATION
16 ! AT ALL. IF UFBINT IS READING VALUES, THEN EITHER BUFR ARCHIVE
17 ! LIBRARY SUBROUTINE READSB OR READNS MUST HAVE BEEN PREVIOUSLY
18 ! CALLED TO READ THE SUBSET FROM UNIT ABS(LUNIN) INTO
19 ! INTERNAL MEMORY. IF IT IS WRITING VALUES, THEN EITHER BUFR ARCHIVE
20 ! LIBRARY SUBROUTINE OPENMG OR OPENMB MUST HAVE BEEN PREVIOUSLY
21 ! CALLED TO OPEN AND INITIALIZE A BUFR MESSAGE WITHIN MEMORY FOR THIS
22 ! ABS(LUNIN).
23 !
24 ! PROGRAM HISTORY LOG:
25 ! 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
26 ! 1996-11-25 J. WOOLLEN -- MODIFIED TO ADD A RETURN CODE WHEN
27 ! MNEMONICS ARE NOT FOUND WHEN READING
28 ! 1996-12-11 J. WOOLLEN -- REMOVED A HARD ABORT FOR USERS WHO TRY TO
29 ! WRITE NON-EXISTING MNEMONICS
30 ! 1996-12-17 J. WOOLLEN -- MODIFIED TO ALWAYS INITIALIZE "USR" ARRAY
31 ! TO MISSING (10E10) WHEN BUFR FILE IS BEING
32 ! READ
33 ! 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
34 ! "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
35 ! ROUTINE "BORT"; IMPROVED MACHINE
36 ! PORTABILITY
37 ! 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
38 ! OPENED AT ONE TIME INCREASED FROM 10 TO 32
39 ! (NECESSARY IN ORDER TO PROCESS MULTIPLE
40 ! BUFR FILES UNDER THE MPI)
41 ! 2002-05-14 J. WOOLLEN -- REMOVED OLD CRAY COMPILER DIRECTIVES
42 ! 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
43 ! INTERDEPENDENCIES
44 ! 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
45 ! INCREASED FROM 15000 TO 16000 (WAS IN
46 ! VERIFICATION VERSION); UNIFIED/PORTABLE FOR
47 ! WRF; ADDED DOCUMENTATION (INCLUDING
48 ! HISTORY); OUTPUTS MORE COMPLETE DIAGNOSTIC
49 ! INFO WHEN ROUTINE TERMINATES ABNORMALLY OR
50 ! UNUSUAL THINGS HAPPEN; CHANGED CALL FROM
51 ! BORT TO BORT2 IN SOME CASES
52 ! 2004-08-18 J. ATOR -- ADDED SAVE FOR IFIRST1 AND IFIRST2 FLAGS
53 !
54 ! USAGE: CALL UFBINT (LUNIN, USR, I1, I2, IRET, STR)
55 ! INPUT ARGUMENT LIST:
56 ! LUNIN - INTEGER: ABSOLUTE VALUE IS FORTRAN LOGICAL UNIT NUMBER
57 ! FOR BUFR FILE
58 ! - IF BUFR FILE OPEN FOR OUTPUT AND LUNIN IS LESS
59 ! THAN ZERO, UFBINT TREATS THE BUFR FILE AS THOUGH
60 ! IT WERE OPEN FOR INPUT
61 ! USR - ONLY IF BUFR FILE OPEN FOR OUTPUT:
62 ! REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES
63 ! WRITTEN TO DATA SUBSET
64 ! I1 - INTEGER: LENGTH OF FIRST DIMENSION OF USR OR THE
65 ! NUMBER OF BLANK-SEPARATED MNEMONICS IN STR (FORMER
66 ! MUST BE AT LEAST AS LARGE AS LATTER)
67 ! I2 - INTEGER:
68 ! - IF BUFR FILE OPEN FOR INPUT: LENGTH OF SECOND
69 ! DIMENSION OF USR
70 ! - IF BUFR FILE OPEN FOR OUTPUT: NUMBER OF "LEVELS"
71 ! OF DATA VALUES TO BE WRITTEN TO DATA SUBSET
72 ! STR - CHARACTER*(*): STRING OF BLANK-SEPARATED TABLE B
73 ! MNEMONICS IN ONE-TO-ONE CORRESPONDENCE WITH FIRST
74 ! DIMENSION OF USR
75 ! - IF BUFR FILE OPEN FOR INPUT: THIS CAN ALSO BE A
76 ! SINGLE TABLE D (SEQUENCE) MNEMONIC WITH EITHER 8-
77 ! OR 16-BIT DELAYED REPLICATION (SEE REMARKS 1)
78 ! - IF BUFR FILE OPEN FOR INPUT: THERE ARE THREE
79 ! "GENERIC" MNEMONICS NOT RELATED TO TABLE B OR D,
80 ! THESE RETURN THE FOLLOWING INFORMATION IN
81 ! CORRESPONDING USR LOCATION:
82 ! 'NUL' WHICH ALWAYS RETURNS MISSING (10E10)
83 ! 'IREC' WHICH ALWAYS RETURNS THE CURRENT BUFR
84 ! MESSAGE (RECORD) NUMBER IN WHICH THIS
85 ! SUBSET RESIDES
86 ! 'ISUB' WHICH ALWAYS RETURNS THE CURRENT SUBSET
87 ! NUMBER OF THIS SUBSET WITHIN THE BUFR
88 ! MESSAGE (RECORD) NUMBER 'IREC'
89 !
90 ! OUTPUT ARGUMENT LIST:
91 ! USR - ONLY IF BUFR FILE OPEN FOR INPUT:
92 ! REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES
93 ! READ FROM DATA SUBSET
94 ! IRET - INTEGER:
95 ! - IF BUFR FILE OPEN FOR INPUT: NUMBER OF "LEVELS" OF
96 ! DATA VALUES READ FROM DATA SUBSET (MUST BE NO
97 ! LARGER THAN I2)
98 ! - IF BUFR FILE OPEN FOR OUTPUT: NUMBER OF "LEVELS"
99 ! OF DATA VALUES WRITTEN TO DATA SUBSET (SHOULD BE
100 ! SAME AS I2)
101 !
102 ! OUTPUT FILES:
103 ! UNIT 06 - STANDARD OUTPUT PRINT
104 !
105 ! REMARKS:
106 ! 1) UFBINT CAN ALSO BE CALLED TO PROVIDE INFORMATION ABOUT A SINGLE
107 ! TABLE D (SEQUENCE) MNEMONIC WITH EITHER 8- OR 16-BIT DELAYED
108 ! REPLICATION IN A SUBSET WHEN THE BUFR FILE IS OPEN FOR INPUT.
109 ! THE MNEMONIC IN STR MUST APPEAR AS IT DOES IN THE BUFR TABLE,
110 ! I.E., BRACKETED BY "{" AND "}" OR "[" AND "]" FOR 8-BIT DELAYED
111 ! REPLICATION, OR BRACKETED BY "(" AND ")" FOR 16-BIT DELAYED
112 ! REPLICATION. {NOTE: THIS WILL NOT WORK FOR SEQUENCES WITH
113 ! 1-BIT DELAYED REPLICATION (BRACKETED BY "<" AND ">"), STANDARD
114 ! REPLICATION (BRACKETED BY "'s), OR NO REPLICATION (NO
115 ! BRACKETING SYMBOLS).}
116 !
117 ! FOR EXAMPLE:
118 !
119 ! CALL UFBINT(LUNIN,PLEVL,1, 50,IRET,'{PLEVL}')
120 !
121 ! WILL RETURN WITH IRET EQUAL TO THE NUMBER OF OCCURRENCES OF THE
122 ! 8-BIT DELAYED REPLICATION SEQUENCE PLEVL IN THE SUBSET AND WITH
123 ! (PLEVL(I),I=1,IRET) EQUAL TO THE NUMBER OF REPLICATIONS IN EACH
124 ! OCCURRENCE OF PLEVL IN THE SUBSET. IF THERE ARE NO OCCURRENCES
125 ! OF PLEVL IN THE SUBSET, IRET IS RETURNED AS ZERO.
126 !
127 ! 2) WHEN THE BUFR FILE IS OPEN FOR OUTPUT, UFBINT CAN BE USED TO
128 ! PRE-ALLOCATE SPACE FOR SOME OR ALL MNEMONICS WITHIN DELAYED
129 ! REPLICATION SEQUENCES. A SUBSEQUENT CALL TO BUFR ARCHIVE
130 ! LIBRARY ROUTINE UFBREP OR UFBSEQ THEN ACTUALLY STORES THE
131 ! VALUES INTO THE BUFR FILES. HERE ARE TWO EXAMPLES OF THIS:
132 !
133 ! EXAMPLE 1) PROBLEM: AN OUTPUT SUBSET "SEQNCE" IS LAID OUT AS
134 ! FOLLOWS IN A BUFR TABLE (NOTE 16 CHARACTERS HAVE BEEN
135 ! REMOVED FROM THE LAST COLUMN TO ALLOW THE TABLE TO FIT IN
136 ! THIS DOCBLOCK):
137 !
138 ! | SEQNCE | {PLEVL} |
139 ! | PLEVL | WSPD WDIR TSIG PRLC TSIG PRLC TSIG PRLC |
140 !
141 ! -- OR --
142 !
143 ! | SEQNCE | {PLEVL} |
144 ! | PLEVL | WSPD WDIR "PSEQ"3 |
145 ! | PSEQ | TSIG PRLC |
146 !
147 ! IN THIS CASE THE APPLICATION PROGRAM MUST STORE VALUES WHICH
148 ! HAVE STANDARD REPLICATION NESTED INSIDE OF A DELAYED
149 ! REPLICATION SEQUENCE. FOR EXAMPLE, ASSUME 50 LEVELS OF WIND
150 ! SPEED, WIND DIRECTION, OBSERVED PRESSURE, FIRST GUESS
151 ! PRESSURE AND ANALYZED PRESSURE ARE TO BE WRITTEN TO "SEQNCE".
152 !
153 ! THE FOLLOWING LOGIC WOULD ENCODE VALUES PROPERLY:
154 !.....................................................................
155 ! ....
156 ! REAL*8 DROBS(2,50)
157 ! REAL*8 SROBS(2,150)
158 ! ....
159 ! DO I=1,50
160 ! DROBS(1,I) = Value of wind speed on level "I"
161 ! DROBS(2,I) = Value of wind direction on level "I"
162 ! SROBS(1,I*3-2) = Value of observed pressure on level "I"
163 ! SROBS(2,I*3-2) = 25. ! Value in Code Table 0-08-021 (TSIG)
164 ! ! for time sigificance (Nominal
165 ! ! reporting time) for observed
166 ! ! pressure on level "I"
167 ! SROBS(1,I*3-1) = Value of first guess pressure on level "I"
168 ! SROBS(2,I*3-1) = 27. ! Value in Code Table 0-08-021 (TSIG)
169 ! ! for time sigificance (First guess)
170 ! ! for first guess pressure on level "I"
171 ! SROBS(1,I*3) = Value of analyzed pressure on level "I"
172 ! SROBS(2,I*3) = 16. ! Value in Code Table 0-08-021 (TSIG)
173 ! ! for time sigificance (Analysis) for
174 ! ! analyzed pressure on level "I"
175 ! ENDDO
176 !
177 ! ! The call to UFBINT here will not only store the 50
178 ! ! values of WSPD and WDIR into the BUFR subset, it
179 ! ! will also allocate the space to store three
180 ! ! replications of TSIG and PRLC on each of the 50
181 ! ! delayed-replication "levels"
182 ! CALL UFBINT(LUNIN,DROBS,2, 50,IRET,'WSPD WDIR')
183 !
184 ! ! The call to UFBREP here will actually store the 150
185 ! ! values of both TSIG and PRLC (three values for each
186 ! ! on 50 delayed-replication "levels")
187 ! CALL UFBREP(LUNIN,SROBS,2,150,IRET,'TSIG PRLC')
188 ! ....
189 ! STOP
190 ! END
191 !.....................................................................
192 !
193 ! A SIMILAR EXAMPLE COULD BE PROVIDED FOR READING VALUES WHICH
194 ! HAVE STANDARD REPLICATION NESTED WITHIN DELAYED REPLICATION,
195 ! FROM BUFR FILES OPEN FOR INPUT. (NOT SHOWN HERE.)
196 !
197 !
198 ! EXAMPLE 2) PROBLEM: AN INPUT SUBSET, "REPT_IN", AND AN OUTPUT
199 ! SUBSET "REPT_OUT", ARE LAID OUT AS FOLLOWS IN A BUFR TABLE
200 ! (NOTE 16 CHARACTERS HAVE BEEN REMOVED FROM THE LAST COLUMN
201 ! TO ALLOW THE TABLE TO FIT IN THIS DOCBLOCK):
202 !
203 ! | REPT_IN | YEAR MNTH DAYS HOUR MINU {PLEVL} CLAT CLON |
204 ! | REPT_OUT | YEAR DOYR HOUR MINU {PLEVL} CLAT CLON |
205 ! | PLEVL | PRLC TMBD REHU WDIR WSPD
206 !
207 ! IN THIS CASE THE APPLICATION PROGRAM IS READING IN VALUES
208 ! FROM A BUFR FILE CONTAINING SUBSET "REPT_IN", CONVERTING
209 ! MONTH AND DAY TO DAY OF YEAR, AND THEN WRITING VALUES TO
210 ! SUBSET "REPT_OUT" IN ANOTHER BUFR FILE. A CONVENIENT WAY TO
211 ! DO THIS IS TO CALL UFBSEQ TO READ IN AND WRITE OUT THE
212 ! VALUES, HOWEVER THIS IS COMPLICATED BY THE PRESENCE OF THE
213 ! DELAYED-RELICATION SEQUENCE "PLEVL" BECAUSE THE OUTPUT CALL
214 ! TO UFBSEQ DOES NOT KNOW A-PRIORI HOW MANY REPLICATIONS ARE
215 ! NEEDED TO STORE THE CONTENTS OF "PLEVL" (IT SETS THE NUMBER
216 ! TO ZERO BY DEFUALT). A CALL TO UFBINT IS FIRST NEEDED TO
217 ! ALLOCATE THE SPACE AND DETERMINE THE NUMBER OF LEVELS NEEDED
218 ! TO STORE ALL VALUES IN "PLEVL".
219 !
220 ! THE FOLLOWING LOGIC WOULD PEFORM THE READ/WRITE PROPERLY:
221 !.....................................................................
222 ! ....
223 ! REAL*8 OBSI(2000),OBSO(1999),PLEVL(5,255),REPS_8
224 ! CHARACTER*8 SUBSET
225 ! ....
226 !
227 ! CALL DATELEN(10)
228 !
229 ! ! Open input BUFR file in LUBFI and open output BUFR file in
230 ! ! LUBFJ, both use the BUFR table in LINDX
231 ! CALL OPENBF(LUBFI,'IN', LINDX)
232 ! CALL OPENBF(LUBFJ,'OUT',LINDX)
233 !
234 ! ! Read through the BUFR messages in the input file
235 ! DO WHILE(IREADMG(LUBFI,SUBSET,IDATE).EQ.0)
236 !
237 ! ! Open message (for writing) in output file
238 ! CALL OPENMB(LUBFJ,'REPT_OUT',IDATE)
239 !
240 ! ! Read through the subsets in this input BUFR messages
241 ! DO WHILE(IREADSB(LUBFI).EQ.0)
242 !
243 ! ! This call to UFBSEQ will read in the entire contents
244 ! ! of subset "REPT_IN", storing them into array OBSI
245 ! ! (Note: On input, UFBSEQ knows how many replications
246 ! of "PLEV" are present)
247 ! CALL UFBSEQ(LUBFI,OBSI,2000,1,IRET,'REPT_IN')
248 !
249 ! ! This call to UFBINT will return the number of
250 ! ! replications ("levels") in "PLEVL" for subset
251 ! ! "REPT_IN"" ! {see 1) above in REMARKS}
252 ! CALL UFBINT(LUBFI,REPS_8,1,1,IRET,'{PLEVL}')
253 ! IREPS = REPS_8
254 !
255 ! IYR = OBSI(1)
256 ! IMO = OBSI(2)
257 ! IDA = OBSI(3)
258 ! CALL xxxx(IYR, IMO, IDA, JDY) ! convert month and day
259 ! ! to day of year (JDY)
260 ! OBSO(1) = OBSI(1)
261 ! OBSO(2) = JDY
262 ! DO I = 3,1999
263 ! OBSO(I) = OBSI(1+1)
264 ! ENDDO
265 !
266 ! PLEVL = 10E10
267 !
268 ! ! The call to UFBINT here will allocate the space to
269 ! ! later allow UFBSEQ to store IREPS replications of
270 ! ! "PLEVL" into the output BUFR subset "REPT_OUT" (note
271 ! ! here it is simply storing missing values)
272 ! CALL UFBINT(LUBFJ,PLEVL,5,IREPS,IRET,
273 ! $ 'PRLC TMBD REHU WDIR WSPD')
274 !
275 ! ! The call to UFBSEQ here will write out the entire
276 ! ! contents of subset "REPT_OUT", reading them from
277 ! ! array OBSO
278 ! CALL UFBSEQ(LUBFJ,OBSO,1999,1,IRET,'REPT_OUT')
279 !
280 ! ! Write the subset into the output BUFR message
281 ! CALL WRITSB(LUBFJ)
282 ! ENDDO
283 !
284 ! ! All done
285 !
286 ! STOP
287 ! END
288 !.....................................................................
289 !
290 !
291 ! THIS ROUTINE CALLS: BORT BORT2 STATUS STRING
292 ! TRYBUMP UFBRW
293 ! THIS ROUTINE IS CALLED BY: UFBINX UFBRMS
294 ! Also called by application programs.
295 !
296 ! ATTRIBUTES:
297 ! LANGUAGE: FORTRAN 77
298 ! MACHINE: PORTABLE TO ALL PLATFORMS
299 !
300 !$$$
302 INCLUDE 'bufrlib.prm'
304 COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES), &
305 INODE(NFILES),IDATE(NFILES)
306 COMMON /USRSTR/ NNOD,NCON,NODS(20),NODC(10),IVLS(10),KONS(10)
307 ! COMMON /USRINT/ NVAL(NFILES),INV(MAXJL,NFILES),VAL(MAXJL,NFILES)
308 COMMON /QUIET / IPRT
310 CHARACTER*(*) STR
311 CHARACTER*128 BORT_STR1,BORT_STR2
312 REAL*8 USR(I1,I2)!,VAL
314 DATA IFIRST1/0/,IFIRST2/0/
316 SAVE IFIRST1, IFIRST2
318 !----------------------------------------------------------------------
319 !----------------------------------------------------------------------
321 IRET = 0
323 ! CHECK THE FILE STATUS AND I-NODE
324 ! --------------------------------
326 LUNIT = ABS(LUNIN)
327 CALL STATUS(LUNIT,LUN,IL,IM)
328 IF(IL.EQ.0) GOTO 900
329 IF(IM.EQ.0) GOTO 901
330 IF(INODE(LUN).NE.INV(1,LUN)) GOTO 902
332 IO = MIN(MAX(0,IL),1)
333 IF(LUNIT.NE.LUNIN) IO = 0
335 IF(I1.LE.0) THEN
336 IF(IPRT.GE.0) THEN
337 PRINT*
338 PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
339 PRINT*,'BUFRLIB: UFBINT - THIRD ARGUMENT (INPUT) IS .LE. 0', &
340 ' - RETURN WITH FIFTH ARGUMENT (IRET) = 0'
341 PRINT*,'STR = ',STR
342 PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
343 PRINT*
344 ENDIF
345 GOTO 100
346 ELSEIF(I2.LE.0) THEN
347 IF(IPRT.EQ.-1) IFIRST1 = 1
348 IF(IO.EQ.0 .OR. IFIRST1.EQ.0 .OR. IPRT.GE.1) THEN
349 PRINT*
350 PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
351 PRINT*,'BUFRLIB: UFBINT - FOURTH ARGUMENT (INPUT) IS .LE.', &
352 ' 0 - RETURN WITH FIFTH ARGUMENT (IRET) = 0'
353 PRINT*,'STR = ',STR
354 IF(IPRT.EQ.0 .AND. IO.EQ.1) PRINT 101
355 101 FORMAT('Note: Only the first occurrence of this WARNING message ', &
356 'is printed, there may be more. To output'/6X,'ALL WARNING ', &
357 'messages, modify your application program to add ', &
358 '"CALL OPENBF(0,''QUIET'',1)" prior'/6X,'to the first call to a', &
359 ' BUFRLIB routine.')
360 PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
361 PRINT*
362 IFIRST1 = 1
363 ENDIF
364 GOTO 100
365 ENDIF
367 ! PARSE OR RECALL THE INPUT STRING
368 ! --------------------------------
370 CALL STRING(STR,LUN,I1,IO)
372 ! INITIALIZE USR ARRAY PRECEEDING AN INPUT OPERATION
373 ! --------------------------------------------------
375 IF(IO.EQ.0) THEN
376 DO J=1,I2
377 DO I=1,I1
378 USR(I,J) = BMISS
379 ENDDO
380 ENDDO
381 ENDIF
383 ! CALL THE MNEMONIC READER/WRITER
384 ! -------------------------------
386 CALL UFBRW(LUN,USR,I1,I2,IO,IRET)
388 ! IF INCOMPLETE WRITE TRY TO INITIALIZE REPLICATION SEQUENCE OR RETURN
389 ! ---------------------------------------------------------------------
391 IF(IO.EQ.1 .AND. IRET.NE.I2 .AND. IRET.GE.0) THEN
392 CALL TRYBUMP(LUNIT,LUN,USR,I1,I2,IO,IRET)
393 IF(IRET.NE.I2) GOTO 903
394 ELSEIF(IRET.EQ.-1) THEN
395 IRET = 0
396 ENDIF
398 IF(IRET.EQ.0) THEN
399 IF(IO.EQ.0) THEN
400 IF(IPRT.GE.1) THEN
401 PRINT*
402 PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
403 PRINT*,'BUFRLIB: UFBINT - NO SPECIFIED VALUES READ IN', &
404 ' - RETURN WITH FIFTH ARGUMENT (IRET) = 0'
405 PRINT*,'STR = ',STR
406 PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
407 PRINT*
408 ENDIF
409 ELSE
410 IF(IPRT.EQ.-1) IFIRST2 = 1
411 IF(IFIRST2.EQ.0 .OR. IPRT.GE.1) THEN
412 PRINT*
413 PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
414 PRINT*,'BUFRLIB: UFBINT - NO SPECIFIED VALUES WRITTEN ', &
415 'OUT - RETURN WITH FIFTH ARGUMENT (IRET) = 0'
416 PRINT*,'STR = ',STR,' MAY NOT BE IN THE BUFR TABLE(?)'
417 IF(IPRT.EQ.0) PRINT 101
418 PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
419 PRINT*
420 IFIRST2 = 1
421 ENDIF
422 ENDIF
423 ENDIF
425 ! EXITS
426 ! -----
428 100 RETURN
429 900 CALL BORT('BUFRLIB: UFBINT - BUFR FILE IS CLOSED, IT MUST BE'// &
430 ' OPEN')
431 901 CALL BORT('BUFRLIB: UFBINT - A MESSAGE MUST BE OPEN IN BUFR '// &
432 'FILE, NONE ARE')
433 902 CALL BORT('BUFRLIB: UFBINT - LOCATION OF INTERNAL TABLE FOR '// &
434 'BUFR FILE DOES NOT AGREE WITH EXPECTED LOCATION IN INTERNAL '// &
435 'SUBSET ARRAY')
436 903 WRITE(BORT_STR1,'("BUFRLIB: UFBINT - MNEMONIC STRING READ IN IS'// &
437 ': ",A)') STR
438 WRITE(BORT_STR2,'(18X,"THE NUMBER OF ''LEVELS'' ACTUALLY '// &
439 'WRITTEN (",I3,") DOES NOT EQUAL THE NUMBER REQUESTED (",I3,")'// &
440 ' - INCOMPLETE WRITE")') IRET,I2
441 CALL BORT2(BORT_STR1,BORT_STR2)
442 END SUBROUTINE UFBINT