readsb.f

Go to the documentation of this file.

C> @file
C> @brief Read the next data subset from a BUFR message.
C>
C> @author J. Woollen @date 1994-01-06
 
C> Read the next data subset from a BUFR message.
C>
C> 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> Whenever this subroutine returns with IRET = 0, this indicates that a
C> new BUFR data subset (i.e. report) was successfully read into internal
C> arrays within the BUFRLIB software, and from where it can be
C> manipulated or further parsed via calls to any of the [values-reading
C> subroutines](@ref hierarchy).
C>
C> If the subroutine returns with IRET = -1 there are no more data
C> subsets available within the current message; a new call needs to
C> be made to one of the [message-reading subroutines](@ref
C> hierarchy) in order to read in the next message from logical unit
C> LUNIT.
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 read into internal arrays.
C> - -1 there are no more BUFR data subsets in the BUFR message.
C>
C> @author J. Woollen @date 1994-01-06
      RECURSIVE SUBROUTINE readsb(LUNIT,IRET)
 
      USE moda_msgcwd
      USE moda_unptyp
      USE moda_bitbuf
      USE moda_bitmaps
      use moda_stcode
      USE modv_im8b
 
      CHARACTER*128 bort_str
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(lunit,my_lunit,1)
         CALL readsb(my_lunit,iret)
         CALL x48(iret,iret,1)
 
         im8b=.true.
         RETURN
      ENDIF
 
      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
      iscodes(lun) = 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)
         if (iscodes(lun) .ne. 0) iret = -1
      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