pkbs1.f

Go to the documentation of this file.

C> @file
C> @brief Write a data value into Section 1 of a BUFR message.

C> This subroutines writes a specified value into a specified location
C> within Section 1 of a BUFR message, overwriting the value previously
C> stored in that location.
C>
C> <p>This subroutine will work on any BUFR message encoded using BUFR
C> edition 2, 3, or 4.  It is similar to subroutine pkvs01(), except
C> that it operates on a BUFR message passed in via a memory array,
C> whereas pkvs01() operates on BUFR messages stored internally within
C> the software.
C>
C> @authors J. Ator
C> @authors D. Keyser
C> @date 2005-11-29
C>  
C> @param[in]     IVAL    - integer: Value to be stored
C> @param[in,out] MBAY    - integer(*): BUFR message
C> @param[in]   S1MNEM    - character*(*): Location in Section 1 of
C>                          MBAY within which to store IVAL
C>                          - 'BMT'   = BUFR master table
C>                          - 'OGCE'  = Originating center
C>                          - 'GSES'  = Originating subcenter
C>                          - 'USN'   = Update sequence number
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>
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 S1MNEM = 'GSES' can only be stored within
C>   BUFR messages encoded using BUFR edition 3 or 4.
C> - Values corresponding to S1MNEM = 'YCEN' or 'CENT' can only be stored
C>   within BUFR messages encoded using BUFR edition 2 or 3.
C> - Values corresponding to S1MNEM = 'YEAR', 'SECO' or 'MSBTI' can only
C>   be stored within BUFR messages encoded using BUFR edition 4.
C>
C> <b>Program history log:</b>
C> - 2005-11-29  J. Ator    -- Original author
C> - 2006-04-14  D. Keyser  -- Added options for 'MTYP', 'MSBT', 'YEAR',
C>                             'MNTH', 'DAYS', 'HOUR', 'YCEN' and 'CENT'
C>
    SUBROUTINE pkbs1(IVAL,MBAY,S1MNEM)

    dimension   mbay(*)

    character*(*)   s1mnem

    character*128   bort_str

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

C   Note that the following call to function IUPBS01 will ensure
C   that subroutine WRDLEN has been called.

    iben = iupbs01(mbay,'BEN')

C   Determine where to store the value.

    CALL gets1loc(s1mnem,iben,isbyt,iwid,iret)
    IF ( (iret.EQ.0) .AND.
     .       ( (s1mnem.EQ.'USN') .OR. (s1mnem.EQ.'BMT')   .OR.
     .         (s1mnem.EQ.'OGCE') .OR. (s1mnem.EQ.'GSES')  .OR.
     .         (s1mnem.EQ.'MTYP') .OR. (s1mnem.EQ.'MSBTI') .OR.
     .         (s1mnem.EQ.'MSBT') .OR. (s1mnem.EQ.'MTV')   .OR.
     .         (s1mnem.EQ.'MTVL') .OR. (s1mnem.EQ.'YCEN')  .OR.
     .         (s1mnem.EQ.'CENT') .OR. (s1mnem.EQ.'YEAR')  .OR.
     .         (s1mnem.EQ.'MNTH') .OR. (s1mnem.EQ.'DAYS')  .OR.
     .         (s1mnem.EQ.'HOUR') .OR. (s1mnem.EQ.'MINU')  .OR.
     .         (s1mnem.EQ.'SECO') ) ) THEN

C       Store the value.

        ibit = (iupbs01(mbay,'LEN0')+isbyt-1)*8
        CALL pkb(ival,iwid,mbay,ibit)
    ELSE
        goto 900
    ENDIF

    RETURN
900 WRITE(bort_str,'("BUFRLIB: PKBS1 - CANNOT OVERWRITE LOCATION '//
     .      'CORRESPONDING TO MNEMONIC (",A,") WITHIN BUFR EDITION '//
     .      '(",I1,")")') s1mnem, iben
        CALL bort(bort_str)
    END