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> This function returns a specified value from within Section 3
C> of a BUFR message.
C>
C> @author J. Ator
C> @date 2009-03-23
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
C>                                     message contains observed data:
C>                                     - 0 = No
C>                                     - 1 = Yes
C>                         - 'ICMP'  = Flag indicating whether the
C>                                     message contains compressed data:
C>                                     - 0 = No
C>                                     - 1 = Yes
C> @returns iupbs3 -- integer: Value corresponding to S3MNEM
C>                      - -1 = S3MNEM was invalid 
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> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2009-03-23 | J. Ator | Original author |
C>
      FUNCTION iupbs3(MBAY,S3MNEM)

    dimension   mbay(*)

    character*(*)   s3mnem

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

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
        iupbs3 = 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
        iupbs3 = min(1,iand(ival,imask))
    ELSE
        iupbs3 = -1
    ENDIF

    RETURN
    END