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> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2005-11-29 | J. Ator    | Original author |
C> | 2006-04-14 | D. Keyser  | Added options for 'MTYP', 'MSBT', 'YEAR', '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