upds3.f

Go to the documentation of this file.

C> @file
C> @brief Read data descriptors from Section 3 of a BUFR message.
C>
C> @author J. Ator @date 2003-11-04
 
C> This subroutine returns the sequence of data descriptors
C> contained within Section 3 of a BUFR message.
C>
C> @remarks
C> - The start of the BUFR message (i.e. the string 'BUFR') must be
C>   aligned on the first 4 bytes of MBAY.
C> - This subroutine does not recursively resolve any Table D
C>   descriptors from within Section 3; rather, what is returned in
C>   CDS3 is the exact list of data descriptors as it appears within
C>   Section 3 of MBAY.
C>
C> @param[in]  MBAY - integer(*): BUFR message.
C> @param[in]  LCDS3 - integer: Dimensioned size (in integers) of CDS3 in the calling
C> program; used by the subroutine to ensure that it doesn't overflow the CDS3 array.
C> @param[out] CDS3 - character*6(*): Data descriptor sequence within Section 3 of MBAY.
C> @param[out] NDS3 - integer: Number of data descriptors in CDS3.
C>
C> @author J. Ator @date 2003-11-04
 
      RECURSIVE SUBROUTINE upds3(MBAY,LCDS3,CDS3,NDS3)
 
      USE modv_im8b
 
      dimension mbay(*)
 
      CHARACTER*6 cds3(*), adn30
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C     Check for I8 integers.
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(lcds3,my_lcds3,1)
         CALL upds3(mbay,my_lcds3,cds3,nds3)
         CALL x48(nds3,nds3,1)
 
         im8b=.true.
         RETURN
      ENDIF
 
C     Call subroutine WRDLEN to initialize some important information
C     about the local machine, just in case subroutine OPENBF hasn't
C     been called yet.
 
      CALL wrdlen
 
C     Skip to the beginning of Section 3.
 
      CALL getlens(mbay,3,len0,len1,len2,len3,l4,l5)
      ipt = len0 + len1 + len2
 
C     Unpack the Section 3 descriptors.
 
      nds3 = 0
      DO jj = 8,(len3-1),2
         nds3 = nds3 + 1
         IF(nds3.GT.lcds3) GOTO 900
         cds3(nds3) = adn30(iupb(mbay,ipt+jj,16),6)
      ENDDO
 
      RETURN
900   CALL bort('BUFRLIB: UPDS3 - OVERFLOW OF OUTPUT DESCRIPTOR '//
     . 'ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY')
      END