updated top-level README and version_decl for V4.5 (#1847)
[WRF.git] / var / external / bufr / pkvs01.f
blob0fdc6f5ccaa701962808ee94898e7626bcb59339
1 SUBROUTINE PKVS01(S01MNEM,IVAL)
3 C$$$ SUBPROGRAM DOCUMENTATION BLOCK
5 C SUBPROGRAM: PKVS01
6 C PRGMMR: ATOR ORG: NP12 DATE: 2005-11-29
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!).
29 C PROGRAM HISTORY LOG:
30 C 2005-11-29 J. ATOR -- ORIGINAL AUTHOR
31 C 2006-04-14 D. KEYSER -- UPDATED DOCBLOCK
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
77 C REMARKS:
78 C THIS ROUTINE CALLS: BORT
79 C THIS ROUTINE IS CALLED BY: BFRINI
80 C Also called by application programs.
82 C ATTRIBUTES:
83 C LANGUAGE: FORTRAN 77
84 C MACHINE: PORTABLE TO ALL PLATFORMS
86 C$$$
88 INCLUDE 'bufrlib.prm'
90 COMMON /S01CM/ NS01V,CMNEM(MXS01V),IVMNEM(MXS01V)
92 CHARACTER*(*) S01MNEM
94 CHARACTER*128 BORT_STR
95 CHARACTER*8 CMNEM
97 DATA IFIRST/0/
99 SAVE IFIRST
101 C-----------------------------------------------------------------------
102 C-----------------------------------------------------------------------
104 IF(IFIRST.EQ.0) THEN
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!
115 NS01V = 0
116 IFIRST = 1
117 ENDIF
119 IF (S01MNEM.EQ.'INIT') THEN
120 RETURN
121 ENDIF
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.
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
135 C OTHERWISE, USE THE NEXT AVAILABLE UNUSED ENTRY IN COMMON /S01CM/.
137 IF(NS01V.GE.MXS01V) GOTO 900
139 NS01V = NS01V + 1
140 CMNEM(NS01V) = S01MNEM
141 IVMNEM(NS01V) = IVAL
143 C EXITS
144 C -----
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)