SUBROUTINE UFBEVN(LUNIT,USR,I1,I2,I3,IRET,STR)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: UFBEVN
C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE READS SPECIFIED VALUES FROM THE CURRENT
C BUFR DATA SUBSET WITHIN INTERNAL ARRAYS. THE DATA VALUES
C CORRESPOND TO MNEMONICS WHICH ARE PART OF A MULTIPLE-REPLICATION
C SEQUENCE WITHIN ANOTHER MULTIPLE-REPLICATION SEQUENCE. THE INNER
C SEQUENCE IS USUALLY ASSOCIATED WITH DATA "LEVELS" AND THE OUTER
C SEQUENCE WITH DATA "EVENTS". THE BUFR FILE IN LOGICAL UNIT LUNIT
C MUST HAVE BEEN OPENED FOR INPUT VIA A PREVIOUS CALL TO BUFR ARCHIVE
C LIBRARY SUBROUTINE OPENBF. IN ADDITION, THE DATA SUBSET MUST HAVE
C SUBSEQUENTLY BEEN READ INTO THE INTERNAL BUFR ARCHIVE LIBRARY
C ARRAYS VIA CALLS TO BUFR ARCHIVE LIBRARY SUBROUTINE READMG OR
C READERME FOLLOWED BY A CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE
C READSB (OR VIA A SINGLE CALL TO BUFR ARCHIVE LIBRARY
C SUBROUTINE READNS). OTHER THAN THE ADDITION OF A THIRD
C DIMENSION AND THE READ ONLY RESTRICTION, THE CONTEXT AND USAGE OF
C UFBEVN IS EXACTLY THE SAME AS FOR BUFR ARCHIVE LIBRARY SUBROUTINES
C UFBINT, UFBREP AND UFBSEQ. THIS SUBROUTINE IS DESIGNED TO READ
C EVENT INFORMATION FROM "PREPBUFR" TYPE BUFR FILES. PREPBUFR FILES
C HAVE THE FOLLOWING BUFR TABLE EVENT STRUCTURE (NOTE SIXTEEN
C CHARACTERS HAVE BEEN REMOVED FROM THE LAST COLUMN TO ALLOW THE
C TABLE TO FIT IN THIS DOCBLOCK):
C
C | ADPUPA | HEADR {PLEVL} |
C | HEADR | SID XOB YOB DHR ELV TYP T29 TSB ITP SQN |
C | PLEVL | CAT <PINFO> <QINFO> <TINFO> <ZINFO> <WINFO> |
C | PINFO | [PEVN] <PBACKG> <PPOSTP> |
C | QINFO | [QEVN] TDO <QBACKG> <QPOSTP> |
C | TINFO | [TEVN] TVO <TBACKG> <TPOSTP> |
C | ZINFO | [ZEVN] <ZBACKG> <ZPOSTP> |
C | WINFO | [WEVN] <WBACKG> <WPOSTP> |
C | PEVN | POB PQM PPC PRC |
C | QEVN | QOB QQM QPC QRC |
C | TEVN | TOB TQM TPC TRC |
C | ZEVN | ZOB ZQM ZPC ZRC |
C | WEVN | UOB WQM WPC WRC VOB |
C | PBACKG | POE PFC |
C | QBACKG | QOE QFC |
C | TBACKG | TOE TFC |
C | ZBACKG | ZOE ZFC |
C | WBACKG | WOE UFC VFC |
C | PPOSTP | PAN |
C | QPOSTP | QAN |
C | TPOSTP | TAN |
C | ZPOSTP | ZAN |
C | WPOSTP | UAN VAN |
C
C NOTE THAT THE EIGHT-BIT DELAYED REPLIATION EVENT SEQUENCES "[xxxx]"
C ARE NESTED INSIDE ONE-BIT DELAYED REPLICATED SEQUENCES "<yyyy>".
C THE ANALOGOUS BUFR ARCHIVE LIBRARY SUBROUTINE UFBIN3 DOES NOT WORK
C PROPERLY ON THIS TYPE OF EVENT STRUCTURE. IT WORKS ONLY ON THE
C EVENT STRUCTURE FOUND IN "PREPFITS" TYPE BUFR FILES (SEE UFBIN3 FOR
C MORE DETAILS). IN TURN, UFBEVN DOES NOT WORK PROPERLY ON THE EVENT
C STRUCTURE FOUND IN PREPFITS FILES (ALWAYS USE UFBIN3 IN THIS CASE).
C ONE OTHER DIFFERENCE BETWEEN UFBEVN AND UFBIN3 IS THAT UFBEVN
C STORES THE MAXIMUM NUMBER OF EVENTS FOUND FOR ALL DATA VALUES
C SPECIFIED AMONGST ALL LEVELS RETURNED INTERNALLY IN COMMON BLOCK
C /UFBN3C/. UFBIN3 RETURNS THIS VALUE AS AN ADDITIONAL OUTPUT
C ARGUMENT.
C
C PROGRAM HISTORY LOG:
C 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
C 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C ROUTINE "BORT"; IMPROVED MACHINE
C PORTABILITY
C 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
C OPENED AT ONE TIME INCREASED FROM 10 TO 32
C (NECESSARY IN ORDER TO PROCESS MULTIPLE
C BUFR FILES UNDER THE MPI)
C 2003-11-04 J. WOOLLEN -- SAVES THE MAXIMUM NUMBER OF EVENTS FOUND
C FOR ALL DATA VALUES SPECIFIED AMONGST ALL
C LEVELS RETURNED AS VARIABLE MAXEVN IN NEW
C COMMON BLOCK /UFBN3C/
C 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
C INTERDEPENDENCIES
C 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
C INCREASED FROM 15000 TO 16000 (WAS IN
C VERIFICATION VERSION); ADDED CALL TO BORT
C IF BUFR FILE IS OPEN FOR OUTPUT; UNIFIED/
C PORTABLE FOR WRF; ADDED DOCUMENTATION
C (INCLUDING HISTORY); OUTPUTS MORE COMPLETE
C DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
C ABNORMALLY OR UNUSUAL THINGS HAPPEN
C 2009-04-21 J. ATOR -- USE ERRWRT
C
C USAGE: CALL UFBEVN (LUNIT, USR, I1, I2, I3, IRET, STR)
C INPUT ARGUMENT LIST:
C LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C I1 - INTEGER: LENGTH OF FIRST DIMENSION OF USR OR THE
C NUMBER OF BLANK-SEPARATED MNEMONICS IN STR (FORMER
C MUST BE .GE. LATTER)
C I2 - INTEGER: LENGTH OF SECOND DIMENSION OF USR
C I3 - INTEGER: LENGTH OF THIRD DIMENSION OF USR (MAXIMUM
C VALUE IS 255)
C STR - CHARACTER*(*): STRING OF BLANK-SEPARATED TABLE B
C MNEMONICS IN ONE-TO-ONE CORRESPONDENCE WITH FIRST
C DIMENSION OF USR
C - THERE ARE THREE "GENERIC" MNEMONICS NOT RELATED
C TO TABLE B, THESE RETURN THE FOLLOWING
C INFORMATION IN CORRESPONDING USR LOCATION:
C 'NUL' WHICH ALWAYS RETURNS BMISS ("MISSING")
C 'IREC' WHICH ALWAYS RETURNS THE CURRENT BUFR
C MESSAGE (RECORD) NUMBER IN WHICH THIS
C SUBSET RESIDES
C 'ISUB' WHICH ALWAYS RETURNS THE CURRENT SUBSET
C NUMBER OF THIS SUBSET WITHIN THE BUFR
C MESSAGE (RECORD) NUMBER 'IREC'
C
C OUTPUT ARGUMENT LIST:
C USR - REAL*8: (I1,I2,I3) STARTING ADDRESS OF DATA VALUES
C READ FROM DATA SUBSET
C IRET - INTEGER: NUMBER OF "LEVELS" OF DATA VALUES READ FROM
C DATA SUBSET (MUST BE NO LARGER THAN I2)
C
C REMARKS:
C APPLICATION PROGRAMS READING PREPFITS FILES SHOULD NOT CALL THIS
C ROUTINE.
C
C THIS ROUTINE CALLS: BORT CONWIN ERRWRT GETWIN
C NVNWIN NXTWIN STATUS STRING
C THIS ROUTINE IS CALLED BY: None
C Normally called only by application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
. INODE(NFILES),IDATE(NFILES)
COMMON /USRINT/ NVAL(NFILES),INV(MAXSS,NFILES),VAL(MAXSS,NFILES)
COMMON /USRSTR/ NNOD,NCON,NODS(20),NODC(10),IVLS(10),KONS(10)
COMMON /UFBN3C/ MAXEVN
COMMON /QUIET / IPRT
CHARACTER*(*) STR
CHARACTER*128 ERRSTR
DIMENSION INVN(255)
REAL*8 VAL,USR(I1,I2,I3)
C----------------------------------------------------------------------
C----------------------------------------------------------------------
MAXEVN = 0
IRET = 0
C CHECK THE FILE STATUS AND I-NODE
C --------------------------------
CALL STATUS(LUNIT,LUN,IL,IM)
IF(IL.EQ.0) GOTO 900
IF(IL.GT.0) GOTO 901
IF(IM.EQ.0) GOTO 902
IF(INODE(LUN).NE.INV(1,LUN)) GOTO 903
IF(I1.LE.0) THEN
IF(IPRT.GE.0) THEN
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
ERRSTR = 'BUFRLIB: UFBEVN - 3rd ARG. (INPUT) IS .LE. 0, ' //
. 'SO RETURN WITH 6th ARG. (IRET) = 0; 7th ARG. (STR) ='
CALL ERRWRT(ERRSTR)
CALL ERRWRT(STR)
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
CALL ERRWRT(' ')
ENDIF
GOTO 100
ELSEIF(I2.LE.0) THEN
IF(IPRT.GE.0) THEN
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
ERRSTR = 'BUFRLIB: UFBEVN - 4th ARG. (INPUT) IS .LE. 0, ' //
. 'SO RETURN WITH 6th ARG. (IRET) = 0; 7th ARG. (STR) ='
CALL ERRWRT(ERRSTR)
CALL ERRWRT(STR)
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
CALL ERRWRT(' ')
ENDIF
GOTO 100
ELSEIF(I3.LE.0) THEN
IF(IPRT.GE.0) THEN
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
ERRSTR = 'BUFRLIB: UFBEVN - 5th ARG. (INPUT) IS .LE. 0, ' //
. 'SO RETURN WITH 6th ARG. (IRET) = 0; 7th ARG. (STR) ='
CALL ERRWRT(ERRSTR)
CALL ERRWRT(STR)
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
CALL ERRWRT(' ')
ENDIF
GOTO 100
ENDIF
C PARSE OR RECALL THE INPUT STRING
C --------------------------------
CALL STRING(STR,LUN,I1,0)
C INITIALIZE USR ARRAY
C --------------------
DO K=1,I3
DO J=1,I2
DO I=1,I1
USR(I,J,K) = BMISS
ENDDO
ENDDO
ENDDO
C LOOP OVER COND WINDOWS
C ----------------------
INC1 = 1
INC2 = 1
1 CALL CONWIN(LUN,INC1,INC2)
IF(NNOD.EQ.0) THEN
IRET = I2
GOTO 100
ELSEIF(INC1.EQ.0) THEN
GOTO 100
ELSE
DO I=1,NNOD
IF(NODS(I).GT.0) THEN
INS2 = INC1
CALL GETWIN(NODS(I),LUN,INS1,INS2)
IF(INS1.EQ.0) GOTO 100
GOTO 2
ENDIF
ENDDO
INS1 = INC1
INS2 = INC2
ENDIF
C READ PUSH DOWN STACK DATA INTO 3D ARRAYS
C ----------------------------------------
2 IRET = IRET+1
IF(IRET.LE.I2) THEN
DO I=1,NNOD
IF(NODS(I).GT.0) THEN
NNVN = NVNWIN(NODS(I),LUN,INS1,INS2,INVN,I3)
MAXEVN = MAX(NNVN,MAXEVN)
DO N=1,NNVN
USR(I,IRET,N) = VAL(INVN(N),LUN)
ENDDO
ENDIF
ENDDO
ENDIF
C DECIDE WHAT TO DO NEXT
C ----------------------
CALL NXTWIN(LUN,INS1,INS2)
IF(INS1.GT.0 .AND. INS1.LT.INC2) GOTO 2
IF(NCON.GT.0) GOTO 1
IF(IRET.EQ.0) THEN
IF(IPRT.GE.1) THEN
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
ERRSTR = 'BUFRLIB: UFBEVN - NO SPECIFIED VALUES READ IN, ' //
. 'SO RETURN WITH 6th ARG. (IRET) = 0; 7th ARG. (STR) ='
CALL ERRWRT(ERRSTR)
CALL ERRWRT(STR)
CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
CALL ERRWRT(' ')
ENDIF
ENDIF
C EXITS
C -----
100 RETURN
900 CALL BORT('BUFRLIB: UFBEVN - INPUT BUFR FILE IS CLOSED, IT MUST'//
. ' BE OPEN FOR INPUT')
901 CALL BORT('BUFRLIB: UFBEVN - INPUT BUFR FILE IS OPEN FOR OUTPUT'//
. ', IT MUST BE OPEN FOR INPUT')
902 CALL BORT('BUFRLIB: UFBEVN - A MESSAGE MUST BE OPEN IN INPUT '//
. 'BUFR FILE, NONE ARE')
903 CALL BORT('BUFRLIB: UFBEVN - LOCATION OF INTERNAL TABLE FOR '//
. 'INPUT BUFR FILE DOES NOT AGREE WITH EXPECTED LOCATION IN '//
. 'INTERNAL SUBSET ARRAY')
END