rdtree.f

Go to the documentation of this file.

C> @file
C> @brief Read the next uncompressed BUFR data subset into internal arrays.
C>
C> @author Woollen @date 1994-01-06
 
C> This subroutine unpacks the next subset from the internal
c> uncompressed message buffer (array mbay in module @ref moda_bitbuf) and
c> stores the unpacked subset within the internal array val(*,lun)
c> in module @ref moda_usrint.
C>
C> @param[in] LUN - integer: I/O stream index into internal memory arrays.
C> @param[out] IRET - integer: return code:
C> - 0 normal return
C> - -1 An error occurred, possibly due to a corrupt subset in the input message.
C>
C> @author Woollen @date 1994-01-06
      SUBROUTINE rdtree(LUN,IRET)
 
      USE modv_bmiss
      USE moda_usrint
      USE moda_usrbit
      USE moda_ival
      USE moda_bitbuf
      USE moda_tables
 
      CHARACTER*8  CVAL
      equivalence(cval,rval)
      real*8       rval,ups
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
      iret = 0
 
C  CYCLE THROUGH A SUBSET SETTING UP THE TEMPLATE
C  ----------------------------------------------
 
      mbit(1) = ibit
      nbit(1) = 0
      CALL rcstpl(lun,ier)
      IF(ier.NE.0) THEN
        iret = -1
        RETURN
      ENDIF
 
C  UNPACK A SUBSET INTO THE USER ARRAY IVAL
C  ----------------------------------------
 
      DO n=1,nval(lun)
      CALL upb8(ival(n),nbit(n),mbit(n),mbay(1,lun))
      ENDDO
 
C  LOOP THROUGH EACH ELEMENT OF THE SUBSET, CONVERTING THE UNPACKED
C  VALUES TO THE PROPER TYPES
C  ----------------------------------------------------------------
 
      DO n=1,nval(lun)
      node = inv(n,lun)
      IF(itp(node).EQ.1) THEN
 
C        The unpacked value is a delayed descriptor replication factor.
 
         val(n,lun) = ival(n)
      ELSEIF(itp(node).EQ.2) THEN
 
C        The unpacked value is a real.
 
         IF (ival(n).LT.2_8**ibt(node)-1) THEN
            val(n,lun) = ups(ival(n),node)
         ELSE
            val(n,lun) = bmiss
         ENDIF
      ELSEIF(itp(node).EQ.3) THEN
 
C        The value is a character string, so unpack it using an
C        equivalenced REAL*8 value.  Note that a maximum of 8 characters
C        will be unpacked here, so a separate subsequent call to BUFR
C        archive library subroutine READLC will be needed to fully
C        unpack any string longer than 8 characters.
 
         cval = ' '
         kbit = mbit(n)
         nbt = min(8,nbit(n)/8)
         CALL upc(cval,nbt,mbay(1,lun),kbit,.true.)
         IF (nbit(n).LE.64 .AND. icbfms(cval,nbt).NE.0) THEN
            val(n,lun) = bmiss
         ELSE
            val(n,lun) = rval
         ENDIF
      ENDIF
      ENDDO
 
      ibit = nbit(nval(lun))+mbit(nval(lun))
 
      RETURN
      END