ufbinx.f

Go to the documentation of this file.

C> @file
C> @brief Read one or more data values from a data subset.
C>
C> @author Woollen @date 2003-11-04
 
C> Read one or more data values from a data subset.
C>
C> If logical unit LUNIT has already been opened for input operations
C> via a previous call to subroutine openbf(), then this subroutine
C> will save the current file position, rewind the file to the
C> beginning, reposition the file to a specified data subset
C> within a specified message, read one or more specified data values
C> from that data subset via an internal call to ufbint(), and then
C> restore the file to its previous position.
C>
C> Otherwise, if logical unit LUNIT has not already been opened for
C> input operations via a previous call to subroutine openbf(),
C> then this subroutine will open it via an internal call to
C> subroutine openbf(), position the file to a specified data subset
C> within a specified message, read one or more specified data values
C> from that data subset via an internal call to ufbint(), and then
C> close the file via an internal call to subroutine closbf().
C>
C> @param[in] LUNIT - integer: Fortran logical unit number for BUFR file.
C> @param[in] IMSG  - integer: Number of BUFR message to be read from
C> the BUFR file, counting from the beginning of the file, but <b>not</b>
C> counting any DX BUFR table messages which may be present in the file
C> @param[in] ISUB  - integer: Number of data subset to be read from
C> read from the (IMSG)th BUFR message, counting from the beginning of
C> the message
C> @param[out] USR - real*8(*,*): Data values
C> @param[in] I1 - integer: First dimension of USR as allocated within the
C> calling program
C> @param[in] I2 - integer: Second dimension of USR as allocated within the
C> calling program
C> @param[out] IRET - integer: Number of replications of STR that were read
C> from the data subset
C> @param[in] STR - character*(*): string of blank-separated Table B
C> mnemonics in one-to-one correspondence with the number of data values
C> that will be read from the data subset into the first dimension of USR
C>
C> @author Woollen @date 2003-11-04
      RECURSIVE SUBROUTINE ufbinx(LUNIT,IMSG,ISUB,USR,I1,I2,IRET,STR)
 
      USE modv_im8b
 
      USE moda_msgcwd
      USE moda_bitbuf
 
      CHARACTER*(*) str
      CHARACTER*128 bort_str
      CHARACTER*8   subset
      LOGICAL       openit
      real*8        usr(i1,i2)
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(lunit,my_lunit,1)
         CALL x84(imsg,my_imsg,1)
         CALL x84(isub,my_isub,1)
         CALL x84(i1,my_i1,1)
         CALL x84(i2,my_i2,1)
         CALL ufbinx(my_lunit,my_imsg,my_isub,usr,my_i1,my_i2,iret,str)
         CALL x48(iret,iret,1)
 
         im8b=.true.
         RETURN
      ENDIF
 
      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