readsb.f

Go to the documentation of this file.

C> @file
C> @brief Read the next data subset from a BUFR message.
      
C> This subroutine reads the next data subset from a BUFR
C> message into internal arrays.
C>
C> @author J. Woollen
C> @date 1994-01-06
C>
C> @param[in] LUNIT    - integer: Fortran logical unit number for BUFR file
C> @param[out] IRET    - integer: return code
C>                           - 0 = new BUFR data subset was successfully
C>                                 read into internal arrays
C>                           - -1 = there are no more BUFR data subsets in
C>                                 the BUFR message
C>
C> <p>Logical unit LUNIT should have already been opened for
C> input operations via a previous call to subroutine openbf(), and a
C> BUFR message should have already been read into internal arrays via
C> a previous call to one of the 
C> [message-reading subroutines](@ref hierarchy).
C>
C> <p>Whenever this subroutine returns with IRET = 0, this indicates
C> that a new BUFR data subset (i.e. report) was successfully read into
C> internal arrays within the BUFRLIB software, and from where it can
C> then be easily manipulated or further parsed via calls to any of the
C> [values-reading subroutines](@ref hierarchy).
C> Otherwise, if the subroutine returns with IRET = -1, then this
C> indicates that there are no more data subsets available within the
C> current message, and therefore that a new call needs to be made to
C> one of the [message-reading subroutines](@ref hierarchy) in order
C> to read in the next message from logical unit LUNIT.
C>
C> <b>Program history log:</b>
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"
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> - 2000-09-19  J. Woollen -- Added call to new routine rdcmps() allowing
C>                           subsets to also be decoded from compressed
C>                           BUFR messages; maximum length increased
C>                           from 10,000 to 20,000 bytes
C> - 2002-05-14  J. Woollen -- Corrected error relating to certain
C>                          foreign file types; removed old Cray
C>                          compiler directives
C> - 2003-11-04  S. Bender  -- Added remarks and routine interdependencies
C> - 2003-11-04  D. Keyser  -- Unified/portable for WRF; added history
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> - 2014-12-10  J. Ator    -- Use modules instead of COMMON blocks
C>
      SUBROUTINE readsb(LUNIT,IRET)

      USE moda_msgcwd
      USE moda_unptyp
      USE moda_bitbuf
      USE moda_bitmaps

      CHARACTER*128 bort_str

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

      iret = 0

C  CHECK THE FILE STATUS
C  ---------------------

      CALL status(lunit,lun,il,im)
      IF(il.EQ.0) goto 900
      IF(il.GT.0) goto 901
      IF(im.EQ.0) THEN
         iret = -1
         goto 100
      ENDIF

C  SEE IF THERE IS ANOTHER SUBSET IN THE MESSAGE
C  ---------------------------------------------

      IF(nsub(lun).EQ.msub(lun)) THEN
         iret = -1
         goto 100
      ELSE
         nsub(lun) = nsub(lun) + 1
      ENDIF

C  READ THE NEXT SUBSET AND RESET THE POINTERS
C  -------------------------------------------

      nbtm = 0
      lstnod = 0
      lstnodct = 0
      linbtm = .false.

      IF(msgunp(lun).EQ.0) THEN
         ibit = mbyt(lun)*8
         CALL upb(nbyt,16,mbay(1,lun),ibit)
         CALL rdtree(lun,ier)
         IF(ier.NE.0) THEN
           iret = -1
           goto 100
         ENDIF
         mbyt(lun) = mbyt(lun) + nbyt
      ELSEIF(msgunp(lun).EQ.1) THEN
c  .... message with "standard" Section 3
         ibit = mbyt(lun)
         CALL rdtree(lun,ier)
         IF(ier.NE.0) THEN
           iret = -1
           goto 100
         ENDIF
         mbyt(lun) = ibit
      ELSEIF(msgunp(lun).EQ.2) THEN
c  .... compressed message
         CALL rdcmps(lun)
      ELSE
         goto 902
      ENDIF

C  EXITS
C  -----

100   RETURN
900   CALL bort('BUFRLIB: READSB - INPUT BUFR FILE IS CLOSED, IT MUST'//
     . ' BE OPEN FOR INPUT')
901   CALL bort('BUFRLIB: READSB - INPUT BUFR FILE IS OPEN FOR OUTPUT'//
     . ', IT MUST BE OPEN FOR INPUT')
902   WRITE(bort_str,'("BUFRLIB: READSB - MESSAGE UNPACK TYPE",I3,"IS'//
     . ' NOT RECOGNIZED")') msgunp
      CALL bort(bort_str)
      END