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>
C> @authors J. Ator, D. Keyser @date 2005-11-29
 
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> 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> @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> @authors J. Ator, D. Keyser @date 2005-11-29
        RECURSIVE SUBROUTINE pkbs1(IVAL,MBAY,S1MNEM)
 
        USE modv_im8b
 
        dimension       mbay(*)
 
        CHARACTER*(*)   s1mnem
 
        CHARACTER*128   bort_str
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C       Check for I8 integers.
 
        IF (im8b) THEN
            im8b = .false.
 
            CALL x84(ival,my_ival,1)
            CALL pkbs1(my_ival,mbay,s1mnem)
 
            im8b = .true.
            RETURN
        END IF
 
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