ufbinx.f

Go to the documentation of this file.

C> @file
C> @author WOOLLEN @date 2003-11-04
      
C> 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> 2014-12-10  J. ATOR    -- USE MODULES INSTEAD OF COMMON BLOCKS
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 (MUST BE AT
C>                LEAST AS LARGE AS THE NUMBER OF BLANK-SEPARATED
C>                MNEMONICS IN STR)
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>
      SUBROUTINE ufbinx(LUNIT,IMSG,ISUB,USR,I1,I2,IRET,STR)
 
      USE moda_msgcwd
      USE moda_bitbuf
 
      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