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 | C | PINFO | [PEVN] | C | QINFO | [QEVN] TDO | C | TINFO | [TEVN] TVO | C | ZINFO | [ZEVN] | C | WINFO | [WEVN] | 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 "". 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