SUBROUTINE UFBINX(LUNIT,IMSG,ISUB,USR,I1,I2,IRET,STR) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: UFBINX C PRGMMR: WOOLLEN ORG: NP20 DATE: 2003-11-04 C C ABSTRACT: THIS SUBROUTINE EITHER OPENS A BUFR FILE CONNECTED TO C LOGICAL UNIT LUNIT FOR INPUT OPERATIONS (IF IT IS NOT ALREADY C OPENED AS SUCH), OR SAVES ITS POSITION AND REWINDS IT TO THE FIRST C DATA MESSAGE (IF BUFR FILE ALREADY OPENED), THEN (VIA A CALL TO C BUFR ARCHIVE LIBRARY SUBROUTINE UFBINT) READS SPECIFIED VALUES FROM C INTERNAL SUBSET ARRAYS ASSOCIATED WITH A PARTICULAR SUBSET FROM A C PARTICULAR BUFR MESSAGE IN A MESSAGE BUFFER. THE PARTICULAR SUBSET C AND BUFR MESSAGE ARE BASED BASED ON THE SUBSET NUMBER IN THE C MESSAGE AND THE MESSAGE NUMBER IN THE BUFR FILE. FINALLY, THIS C SUBROUTINE EITHER CLOSES THE BUFR FILE IN LUNIT (IF IS WAS OPENED C HERE) OR RESTORES IT TO ITS PREVIOUS READ/WRITE STATUS AND POSITION C (IF IT WAS NOT OPENED HERE). SEE UFBINT FOR MORE INFORMATION ON C THE READING OF VALUES OUT OF A BUFR MESSAGE SUBSET. NOTE: THE C MESSAGE NUMBER HERE DOES NOT INCLUDE THE DICTIONARY MESSAGES AT THE C BEGINNING OF THE FILE. C C PROGRAM HISTORY LOG: C 2003-11-04 J. WOOLLEN -- ORIGINAL AUTHOR (WAS IN VERIFICATION C VERSION BUT MAY HAVE BEEN IN THE PRODUCTION C VERSION AT ONE TIME AND THEN REMOVED) C 2003-11-04 D. KEYSER -- UNIFIED/PORTABLE FOR WRF; ADDED C DOCUMENTATION; OUTPUTS MORE COMPLETE C DIAGNOSTIC INFO WHEN ROUTINE TERMINATES C ABNORMALLY C 2004-08-09 J. ATOR -- MAXIMUM MESSAGE LENGTH INCREASED FROM C 20,000 TO 50,000 BYTES C 2009-03-23 J. ATOR -- MODIFY LOGIC TO HANDLE BUFR TABLE MESSAGES C ENCOUNTERED ANYWHERE IN THE FILE (AND NOT C JUST AT THE BEGINNING!) C 2012-09-15 J. WOOLLEN -- MODIFIED FOR C/I/O/BUFR INTERFACE C USE 'INX' ARGUMENT TO OPENBF C C USAGE: CALL UFBINX (LUNIT, IMSG, ISUB, USR, I1, I2, IRET, STR) C INPUT ARGUMENT LIST: C LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE C IMSG - INTEGER: POINTER TO BUFR MESSAGE NUMBER TO READ IN C BUFR FILE C ISUB - INTEGER: POINTER TO SUBSET NUMBER TO READ IN BUFR C MESSAGE C I1 - INTEGER: LENGTH OF FIRST DIMENSION OF USR OR THE C NUMBER OF BLANK-SEPARATED MNEMONICS IN STR (FORMER C MUST BE AT LEAST AS LARGE AS LATTER) C I2 - INTEGER: LENGTH OF SECOND DIMENSION OF USR C STR - CHARACTER*(*): STRING OF BLANK-SEPARATED TABLE B C MNEMONICS IN ONE-TO-ONE CORRESPONDENCE WITH FIRST C DIMENSION OF USR {THIS CAN ALSO BE A SINGLE TABLE D C (SEQUENCE) MNEMONIC WITH EITHER 8- OR 16-BIT DELAYED C REPLICATION (SEE REMARKS 1 IN UFBINT DOCBLOCK)} C C OUTPUT ARGUMENT LIST: C USR - REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES READ C 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 INPUT FILES: C UNIT "LUNIT" - BUFR FILE C C REMARKS: C THIS ROUTINE CALLS: BORT CLOSBF OPENBF READMG C READSB REWNBF STATUS UFBINT C UPB 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 /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES), . MBAY(MXMSGLD4,NFILES) CHARACTER*(*) STR CHARACTER*128 BORT_STR CHARACTER*8 SUBSET LOGICAL OPENIT REAL*8 USR(I1,I2) C----------------------------------------------------------------------- C----------------------------------------------------------------------- CALL STATUS(LUNIT,LUN,IL,IM) OPENIT = IL.EQ.0 IF(OPENIT) THEN C OPEN BUFR FILE CONNECTED TO UNIT LUNIT IF IT IS NOT ALREADY OPEN C ---------------------------------------------------------------- CALL OPENBF(LUNIT,'INX',LUNIT) ELSE C IF BUFR FILE ALREADY OPENED, SAVE POSITION & REWIND TO FIRST DATA MSG C --------------------------------------------------------------------- CALL REWNBF(LUNIT,0) ENDIF C SKIP TO MESSAGE # IMSG C ---------------------- C Note that we need to use subroutine READMG to actually read in all C of the messages (including the first (IMSG-1) messages!), just in C case there are any embedded dictionary messages in the file. DO I=1,IMSG CALL READMG(LUNIT,SUBSET,JDATE,JRET) IF(JRET.LT.0) GOTO 901 ENDDO C POSITION AT SUBSET # ISUB C ------------------------- DO I=1,ISUB-1 IF(NSUB(LUN).GT.MSUB(LUN)) GOTO 902 IBIT = MBYT(LUN)*8 CALL UPB(NBYT,16,MBAY(1,LUN),IBIT) MBYT(LUN) = MBYT(LUN) + NBYT NSUB(LUN) = NSUB(LUN) + 1 ENDDO CALL READSB(LUNIT,JRET) IF(JRET.NE.0) GOTO 902 CALL UFBINT(LUNIT,USR,I1,I2,IRET,STR) IF(OPENIT) THEN C CLOSE BUFR FILE IF IT WAS OPENED HERE C ------------------------------------- CALL CLOSBF(LUNIT) ELSE C RESTORE BUFR FILE TO PREV. STATUS & POSITION IF NOT ORIG. OPENED HERE C --------------------------------------------------------------------- CALL REWNBF(LUNIT,1) ENDIF C EXITS C ----- RETURN 901 WRITE(BORT_STR,'("BUFRLIB: UFBINX - HIT END OF FILE BEFORE '// . 'READING REQUESTED MESSAGE NO.",I5," IN BUFR FILE CONNECTED TO'// . ' UNIT",I4)') IMSG,LUNIT CALL BORT(BORT_STR) 902 WRITE(BORT_STR,'("BUFRLIB: UFBINX - ALL SUBSETS READ BEFORE '// . 'READING REQ. SUBSET NO.",I3," IN REQ. MSG NO.",I5," IN BUFR '// . 'FILE CONNECTED TO UNIT",I4)') ISUB,IMSG,LUNIT CALL BORT(BORT_STR) END