125 SUBROUTINE ufbstp(LUNIN,USR,I1,I2,IRET,STR)
134 CHARACTER*128 bort_str1,bort_str2,errstr
137 DATA ifirst1/0/,ifirst2/0/
139 SAVE ifirst1, ifirst2
150 CALL
status(lunit,lun,il,im)
153 IF(inode(lun).NE.inv(1,lun)) goto 902
155 io = min(max(0,il),1)
156 IF(lunin.NE.lunit) io = 0
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) ='
165 CALL
errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
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) ='
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 ' //
182 errstr =
'modify your application program to add ' //
183 .
'"CALL OPENBF(0,''QUIET'',1)" prior to the first call ' //
184 .
'to a BUFRLIB routine.'
187 CALL
errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
208 CALL
string(str,lun,i1,io)
213 CALL
ufbsp(lun,usr,i1,i2,io,iret)
215 IF(io.EQ.1 .AND. iret.NE.i2) goto 903
220 CALL
errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
221 errstr =
'BUFRLIB: UFBSTP - NO SPECIFIED VALUES READ IN, ' //
222 .
'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
225 CALL
errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
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) ='
236 CALL
errwrt(
'MAY NOT BE IN THE BUFR TABLE(?)')
238 errstr =
'Note: Only the first occurrence of this WARNING ' //
239 .
'message is printed, there may be more. To output all ' //
242 errstr =
'modify your application program to add ' //
243 .
'"CALL OPENBF(0,''QUIET'',1)" prior to the first call ' //
244 .
'to a BUFRLIB routine.'
247 CALL
errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
258 900 CALL
bort(
'BUFRLIB: UFBSTP - BUFR FILE IS CLOSED, IT MUST BE'//
260 901 CALL
bort(
'BUFRLIB: UFBSTP - A MESSAGE MUST BE OPEN IN BUFR '//
262 902 CALL
bort(
'BUFRLIB: UFBSTP - LOCATION OF INTERNAL TABLE FOR '//
263 .
'BUFR FILE DOES NOT AGREE WITH EXPECTED LOCATION IN INTERNAL '//
265 903
WRITE(bort_str1,
'("BUFRLIB: UFBSTP - MNEMONIC STRING READ IN IS'//
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)
subroutine bort2(STR1, STR2)
This subroutine calls subroutine errwrt() to log two error messages, then calls subroutine bort_exit(...
This module declares and initializes the BMISS variable.
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...
subroutine string(STR, LUN, I1, IO)
THIS SUBROUTINE CHECKS TO SEE IF A USER-SPECIFIED CHARACTER STRING IS IN THE STRING CACHE (ARRAYS IN ...
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...
subroutine status(LUNIT, LUN, IL, IM)
This subroutine checks whether a specified Fortran logical unit number is currently connected to the ...
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...