iupbs01.f

Go to the documentation of this file.

C> @file
C> @brief Read a data value from Section 0 or Section 1 of a BUFR
C> message.
 
C> This function returns a specified value from within Section 0 or
C> Section 1 of a BUFR message.
C>
C> <p>This function will work on any BUFR message encoded using BUFR
C> edition 2, 3, or 4.  It is similar to function iupvs01(), except
C> that it operates on a BUFR message passed in via a memory array,
C> whereas iupvs01() operates on the BUFR message that was read into
C> internal arrays via the most recent call to any of the other
C> [message-reading subroutines](@ref hierarchy) for a specified
C> Fortran logical unit.
C>
C> @author J. Ator
C> @date 2005-11-29
C>
C> @param[in]  MBAY   -- integer(*): BUFR message
C> @param[in]  S01MNEM  -- character*(*): Value to be read from
C>                         Section 0 or Section 1 of MBAY
C>                         - 'LENM'  = Length (in bytes) of BUFR message
C>                         - 'LEN0'  = Length (in bytes) of Section 0
C>                         - 'LEN1'  = Length (in bytes) of Section 1
C>                         - 'BEN'   = BUFR edition number
C>                         - 'BMT'   = BUFR master table
C>                         - 'OGCE'  = Originating center
C>                         - 'GSES'  = Originating subcenter
C>                         - 'USN'   = Update sequence number
C>                         - 'ISC2'  = Flag indicating absence/presence of
C>                                     (optional) Section 2 in BUFR message:
C>                                    - 0 = Section 2 absent
C>                                    - 1 = Section 2 present
C>                         - 'MTYP'  = Data category
C>                         - 'MSBTI' = Data subcategory (international)
C>                         - 'MSBT'  = Data subcategory (local)
C>                         - 'MTV'   = Version number of master table
C>                         - 'MTVL'  = Version number of local tables
C>                         - 'YCEN'  = Year of century (1-100)
C>                         - 'CENT'  = Century (e.g., 20 for years 1901-2000,
C>                                     21 for years 2001-2100)
C>                         - 'YEAR'  = Year (4-digit)
C>                         - 'MNTH'  = Month
C>                         - 'DAYS'  = Day
C>                         - 'HOUR'  = Hour
C>                         - 'MINU'  = Minute
C>                         - 'SECO'  = Second
C> @returns iupbs01 -- integer: Value corresponding to S01MNEM
C>                      - -1 = S01MNEM was invalid for the edition of BUFR
C>                             message in MBAY, or some other error 
C>                             occurred
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> - Values corresponding to S01MNEM = 'GSES' can only be read from
C>   BUFR messages encoded using BUFR edition 3 or 4.
C> - Values corresponding to S01MNEM = 'YCEN' or 'CENT' can only be
C>   read from BUFR messages encoded using BUFR edition 2 or 3.
C> - When reading from BUFR messages encoded using BUFR edition 2
C>   or 3, values corresponding to S01MNEM = 'YEAR' will be
C>   calculated internally using the values for 'YCEN' and 'CENT',
C>   or inferred using a windowing technique
C> - Values corresponding to S01MNEM = 'SECO' or 'MSBTI' can only
C>   be read from BUFR messages encoded using BUFR edition 4.
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2005-11-29 | J. Ator | Original author |
C> | 2006-04-14 | J. Ator | Added options for 'YCEN' and 'CENT'; restructured logic |
C>
      FUNCTION iupbs01(MBAY,S01MNEM)
 
    dimension   mbay(*)
 
    character*(*)   s01mnem
 
    logical     ok4cent
 
C-----------------------------------------------------------------------
C   This statement function checks whether its input value contains
C       a valid century value.
 
    ok4cent(ival) = ((ival.GE.19).AND.(ival.LE.21))
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   Handle some simple requests that do not depend on the BUFR
C       edition number.
 
    IF(s01mnem.EQ.'LENM') THEN
        iupbs01 = iupb(mbay,5,24)
        RETURN
    ENDIF
 
    len0 = 8
    IF(s01mnem.EQ.'LEN0') THEN
        iupbs01 = len0
        RETURN
    ENDIF
 
C   Get the BUFR edition number.
 
    iben = iupb(mbay,8,8)
    IF(s01mnem.EQ.'BEN') THEN
        iupbs01 = iben
        RETURN
    ENDIF
 
C   Use the BUFR edition number to handle any other requests.
 
    CALL gets1loc(s01mnem,iben,isbyt,iwid,iret)
    IF(iret.EQ.0) THEN
        iupbs01 = iupb(mbay,len0+isbyt,iwid)
        IF(s01mnem.EQ.'CENT') THEN
 
C       Test whether the returned value was a valid
C       century value.
 
        IF(.NOT.ok4cent(iupbs01)) iupbs01 = -1
            ENDIF
        ELSE IF( (s01mnem.EQ.'YEAR') .AND. (iben.LT.4) ) THEN
 
C       Calculate the 4-digit year.
 
        iyoc = iupb(mbay,21,8)
        icen = iupb(mbay,26,8)
 
C       Does ICEN contain a valid century value?
 
        IF(ok4cent(icen)) THEN
 
C               YES, so use it to calculate the 4-digit year. Note that,
C               by international convention, the year 2000 was the 100th
C               year of the 20th century, and the year 2001 was the 1st
C               year of the 21st century
 
        iupbs01 = (icen-1)*100 + iyoc
        ELSE
 
C               NO, so use a windowing technique to determine the
C               4-digit year from the year of the century.
 
        iupbs01 = i4dy(mod(iyoc,100)*1000000)/10**6
        ENDIF
    ELSE
        iupbs01 = -1
    ENDIF
 
    RETURN
    END