var/external/bufr/ufbint.f

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