pkvs01.F

Go to the documentation of this file.

C> @file
C> @brief Specify a value to be included in Section 0 or Section 1 when
C> writing BUFR messages.

C> This subroutine is used to specify a value to be written into a
C> specified location within Section 0 or Section 1 of all BUFR messages
C> output by future calls to other
C> [message-writing subroutines](@ref hierarchy) and
C> [subset-writing subroutines](@ref hierarchy).
C>
C> <p>This subroutine is similar to subroutine pkbs1(), except that
C> pkbs1() operates on a single BUFR message passed in via a memory
C> array.  Alternatively, whenever this subroutine is called, the
C> specified IVAL will be written into all BUFR messages output by all
C> future calls to other [message-writing subroutines](@ref hierarchy)
C> and [subset-writing subroutines](@ref hierarchy),
C> for all Fortran logical units that are open for
C> output within the application program, unless a subsequent call is
C> made to this subroutine with the same value of S01MNEM in order to
C> reset the corresponding IVAL again.  Otherwise, if this subroutine
C> is never called for a particular value of S01MNEM, then a default
C> value is used for the corresponding IVAL, as set within subroutine
C> msgini(), cmsgini() or dxmini().
C>
C> @authors J. Ator
C> @date 2005-11-29
C>
C> @param[in]     IVAL    - integer: Value to be stored
C> @param[in]  S01MNEM    - character*(*): Location where IVAL is to
C>                          be stored within Section 0 or Section 1 of
C>                          all future output BUFR messages
C>                          - 'BEN'   = BUFR edition number
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> - A separate call to this subroutine must be made for each value of
C>   S01MNEM that is to be set within Section 0 or Section 1 of
C>   all future output BUFR messages.
C> - A call to this subroutine with S01MNEM = 'BEN' and IVAL = 4 will
C>   force all future output BUFR messages to be encoded using BUFR
C>   edition 4; otherwise, messages will be encoded using BUFR edition 3
C>   by default.
C> - Values corresponding to S01MNEM = 'YCEN' or 'CENT' can only be stored
C>   within BUFR messages encoded using BUFR edition 3.
C> - Values corresponding to S01MNEM = '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  -- Updated docblock
C> - 2015-03-03  J. Ator    -- Use module MODA_S01CM
C>
      SUBROUTINE pkvs01(S01MNEM,IVAL)

      USE moda_s01cm

      CHARACTER*(*) s01mnem

      CHARACTER*128 bort_str

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

#ifdef DYNAMIC_ALLOCATION

C     CONFIRM THAT THE ARRAYS NEEDED BY THIS SUBROUTINE HAVE ALREADY
C     BEEN ALLOCATED (AND IF NOT, GO AHEAD AND ALLOCATE THEM NOW), SINCE
C     IT'S POSSIBLE FOR THIS SUBROUTINE TO BE CALLED BEFORE THE FIRST
C     CALL TO SUBROUTINE OPENBF.

      IF ( ( .NOT. ALLOCATED(cmnem) ) .OR.
     .     ( .NOT. ALLOCATED(ivmnem) ) )  THEN
        CALL openbf(0,'FIRST',0)
      ENDIF
#endif

C     IF AN IVAL HAS ALREADY BEEN ASSIGNED FOR THIS PARTICULAR S01MNEM,
C     THEN OVERWRITE THAT ENTRY IN COMMON /S01CM/ USING THE NEW IVAL.

      IF(ns01v.GT.0) THEN
        DO i=1,ns01v
          IF(s01mnem.EQ.cmnem(i)) THEN
            ivmnem(i) = ival
            RETURN
          ENDIF
        ENDDO
      ENDIF

C     OTHERWISE, USE THE NEXT AVAILABLE UNUSED ENTRY IN COMMON /S01CM/.

      IF(ns01v.GE.mxs01v) goto 900

      ns01v = ns01v + 1
      cmnem(ns01v) = s01mnem
      ivmnem(ns01v) = ival

C  EXITS
C  -----

      RETURN
900   WRITE(bort_str,'("BUFRLIB: PKVS01 - CANNOT OVERWRITE MORE THAN '//
     . '",I2," DIFFERENT LOCATIONS WITHIN SECTION 0 OR SECTION 1")')
     . mxs01v
      CALL bort(bort_str)
      END