var/external/bufr/pkvs01.f

   1       SUBROUTINE PKVS01(S01MNEM,IVAL)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    PKVS01
   6 C   PRGMMR: ATOR            ORG: NP12       DATE: 2005-11-29
   7 C
   8 C ABSTRACT:  THIS SUBROUTINE IS USED TO SPECIFY A VALUE TO BE WRITTEN
   9 C   INTO A SPECIFIED LOCATION WITHIN SECTION 0 OR SECTION 1 OF ALL BUFR
  10 C   MESSAGES THAT WILL BE OUTPUT BY FUTURE CALLS TO ANY OF THE BUFR
  11 C   ARCHIVE LIBRARY SUBROUTINES WHICH CREATE SUCH MESSAGES (E.G. WRITCP,
  12 C   WRITSB, COPYMG, WRITSA, ETC.).  IT WILL WORK ON ANY MESSAGE ENCODED
  13 C   USING BUFR EDITION 2, 3 OR 4, AND IT CAN BE CALLED AT ANY TIME,
  14 C   INCLUDING BEFORE THE FIRST CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE
  15 C   OPENBF IF IT IS DESIRED FOR THE NEW VALUE TO ALSO BE INCLUDED IN ANY
  16 C   DX DICTIONARY TABLE MESSAGES THAT WILL BE OUTPUT BY BUFR ARCHIVE
  17 C   LIBRARY SUBROUTINE WRITDX.  IN ANY CASE, THE LOCATION WITHIN WHICH
  18 C   TO STORE THE VALUE IS SPECIFIED VIA THE MNEMONIC S01MNEM, AS
  19 C   EXPLAINED IN FURTHER DETAIL BELOW.  IF MULTIPLE VALUES ARE DESIRED
  20 C   TO BE CHANGED WITHIN SECTION 0 OR SECTION 1 OF FUTURE OUTPUT
  21 C   MESSAGES, THEN EACH SUCH VALUE (AND CORRESPONDING LOCATION)
  22 C   SHOULD BE SPECIFIED USING A SEPARATE CALL TO THIS SUBROUTINE.
  23 C   NOTE THAT EACH CALL TO THIS SUBROUTINE WITH A PARTICULAR LOCATION
  24 C   SPECIFICATION WILL OVERRIDE THE EFFECT OF ANY PREVIOUS CALL WITH
  25 C   THAT SAME SPECIFICATION (OR, IN THE CASE OF THE FIRST CALL WITH A
  26 C   PARTICULAR LOCATION SPECIFICATION, IT WILL OVERRIDE THE DEFAULT
  27 C   SECTION 0 OR SECTION 1 VALUE FOR THE CORRESPONDING LOCATION!).
  28 C
  29 C PROGRAM HISTORY LOG:
  30 C 2005-11-29  J. ATOR    -- ORIGINAL AUTHOR
  31 C 2006-04-14  D. KEYSER  -- UPDATED DOCBLOCK
  32 C
  33 C USAGE:    CALL PKVS01(S01MNEM,IVAL)
  34 C   INPUT ARGUMENT LIST:
  35 C     S01MNEM  - CHARACTER*(*): MNEMONIC SPECIFYING LOCATION WHERE IVAL
  36 C                IS TO BE STORED WITHIN SECTION 0 OR SECTION 1 OF ALL
  37 C                FUTURE OUTPUT BUFR MESSAGES:
  38 C                  'BEN'   = BUFR EDITION NUMBER
  39 C                  'BMT'   = BUFR MASTER TABLE
  40 C                  'OGCE'  = ORIGINATING CENTER
  41 C                  'GSES'  = ORIGINATING SUBCENTER
  42 C                              (NOTE: THIS VALUE WILL BE STORED ONLY IN
  43 C                                     BUFR EDITION 3 OR 4 MESSAGES!)
  44 C                  'USN'   = UPDATE SEQUENCE NUMBER
  45 C                  'MTYP'  = DATA CATEGORY
  46 C                  'MSBTI' = DATA SUBCATEGORY (INTERNATIONAL)
  47 C                              (NOTE: THIS VALUE WILL BE STORED ONLY IN
  48 C                                     BUFR EDITION 4 MESSAGES!)
  49 C                  'MSBT'  = DATA SUBCATEGORY (LOCAL)
  50 C                  'MTV'   = VERSION NUMBER OF MASTER TABLE
  51 C                  'MTVL'  = VERSION NUMBER OF LOCAL TABLES
  52 C                  'YCEN'  = YEAR OF CENTURY (1-100)
  53 C                              (NOTE: THIS VALUE WILL BE STORED ONLY IN
  54 C                                     BUFR EDITION 2 AND 3 MESSAGES!)
  55 C                  'CENT'  = CENTURY (I.E., 20 FOR YEARS 1901-2000,
  56 C                                           21 FOR YEARS 2001-2100)
  57 C                              (NOTE: THIS VALUE WILL BE STORED ONLY IN
  58 C                                     BUFR EDITION 2 AND 3 MESSAGES!)
  59 C                  'YEAR'  = YEAR (4-DIGIT)
  60 C                              (NOTE: THIS VALUE WILL BE STORED ONLY IN
  61 C                                     BUFR EDITION 4 MESSAGES!)
  62 C                  'MNTH'  = MONTH
  63 C                  'DAYS'  = DAY
  64 C                  'HOUR'  = HOUR
  65 C                  'MINU'  = MINUTE
  66 C                  'SECO'  = SECOND
  67 C                              (NOTE: THIS VALUE WILL BE STORED ONLY IN
  68 C                                     BUFR EDITION 4 MESSAGES!)
  69 C                  'INIT'  = THIS IS A SPECIAL FLAG TO FORCE THE
  70 C                            INITIALIZATION OF NS01V = 0 WITHIN
  71 C                            COMMON /S01CM/; IN THIS CASE IVAL IS
  72 C                            IGNORED
  73 C                              (NOTE: AN APPLICATION PROGRAM SHOULD
  74 C                                     NEVER ITSELF NEED TO DO THIS!)
  75 C     IVAL     - INTEGER: NEW VALUE FOR LOCATION POINTED TO BY S01MNEM
  76 C
  77 C REMARKS:
  78 C    THIS ROUTINE CALLS:        BORT
  79 C    THIS ROUTINE IS CALLED BY: BFRINI
  80 C                               Also called by application programs.
  81 C
  82 C ATTRIBUTES:
  83 C   LANGUAGE: FORTRAN 77
  84 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  85 C
  86 C$$$
  87
  88       INCLUDE 'bufrlib.prm'
  89
  90       COMMON /S01CM/  NS01V,CMNEM(MXS01V),IVMNEM(MXS01V)
  91
  92       CHARACTER*(*) S01MNEM
  93
  94       CHARACTER*128 BORT_STR
  95       CHARACTER*8   CMNEM
  96
  97       DATA IFIRST/0/
  98
  99       SAVE IFIRST
 100
 101 C-----------------------------------------------------------------------
 102 C-----------------------------------------------------------------------
 103
 104       IF(IFIRST.EQ.0) THEN
 105
 106 C       NOTE THAT WE ARE INITIALIZING NS01V=0 HERE (RATHER THAN WITHIN
 107 C       SUBROUTINE BFRINI) IN ORDER TO ALLOW FOR THE POSSIBILITY THAT A
 108 C       USER MAY CALL SUBROUTINE PKVS01 PRIOR TO CALLING SUBROUTINE
 109 C       OPENBF (WHICH ITSELF CALLS BFRINI!).  HOWEVER, IF THE USER DOES
 110 C       NOT DO THIS, THEN THE "CALL PKVS01('INIT',-99)" STATEMENT WITHIN
 111 C       BFRINI WILL ENSURE THAT THE REQUIRED INITIALIZATION OF NS01V=0
 112 C       STILL GETS DONE; OTHERWISE, WE WOULD RUN THE RISK OF NS01V BEING
 113 C       UNINITIALIZED WHEN REFERENCED LATER ON WITHIN SUBROUTINE MSGWRT!
 114
 115         NS01V = 0
 116         IFIRST = 1
 117       ENDIF
 118
 119       IF (S01MNEM.EQ.'INIT') THEN
 120         RETURN
 121       ENDIF
 122
 123 C     IF AN IVAL HAS ALREADY BEEN ASSIGNED FOR THIS PARTICULAR S01MNEM,
 124 C     THEN OVERWRITE THAT ENTRY IN COMMON /S01CM/ USING THE NEW IVAL.
 125
 126       IF(NS01V.GT.0) THEN
 127         DO I=1,NS01V
 128           IF(S01MNEM.EQ.CMNEM(I)) THEN
 129             IVMNEM(I) = IVAL
 130             RETURN
 131           ENDIF
 132         ENDDO
 133       ENDIF
 134
 135 C     OTHERWISE, USE THE NEXT AVAILABLE UNUSED ENTRY IN COMMON /S01CM/.
 136
 137       IF(NS01V.GE.MXS01V) GOTO 900
 138
 139       NS01V = NS01V + 1
 140       CMNEM(NS01V) = S01MNEM
 141       IVMNEM(NS01V) = IVAL
 142
 143 C  EXITS
 144 C  -----
 145
 146       RETURN
 147 900   WRITE(BORT_STR,'("BUFRLIB: PKVS01 - CANNOT OVERWRITE MORE THAN '//
 148      . '",I2," DIFFERENT LOCATIONS WITHIN SECTION 0 OR SECTION 1")')
 149      . MXS01V
 150       CALL BORT(BORT_STR)
 151       END