iupbs3.f

Go to the documentation of this file.

C> @file
C> @brief Read a data value from Section 3 of a BUFR message.
C>
C> @author J. Ator @date 2009-03-23
 
C> This function returns a specified value from within Section 3
C> 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>
C> @param[in] MBAY - integer(*): BUFR message
C> @param[in] S3MNEM - character*(*): Value to be read from
C> Section 3 of MBAY
C> - 'NSUB'  = Number of data subsets
C> - 'IOBS'  = Flag indicating whether the message contains observed data:
C>   - 0 = No
C>   - 1 = Yes
C> - 'ICMP'  = Flag indicating whether the message contains compressed data:
C>   - 0 = No
C>   - 1 = Yes
C>
C> @returns iupbs3 - integer: Value corresponding to S3MNEM
C> - -1 = S3MNEM was invalid
C>
C> @author J. Ator @date 2009-03-23
 
        RECURSIVE FUNCTION iupbs3(MBAY,S3MNEM) RESULT(IRET)
 
        USE modv_im8b
 
        dimension       mbay(*)
 
        CHARACTER*(*)   s3mnem
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C       Check for I8 integers.
 
        IF(im8b) THEN
           im8b=.false.
 
           iret = iupbs3(mbay,s3mnem)
 
           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 requested value.
 
        IF(s3mnem.EQ.'NSUB') THEN
           iret = iupb(mbay,ipt+5,16)
        ELSE IF( (s3mnem.EQ.'IOBS') .OR. (s3mnem.EQ.'ICMP') ) THEN
           ival = iupb(mbay,ipt+7,8)
           IF(s3mnem.EQ.'IOBS') THEN
              imask = 128
           ELSE
              imask = 64
           ENDIF
           iret = min(1,iand(ival,imask))
        ELSE
           iret = -1
        ENDIF
 
        RETURN
        END