updated top-level README and version_decl for V4.5 (#1847)
[WRF.git] / var / external / bufr / pkbs1.f
blob64ec92c73d7ff123d4479219feabb5be58e2dc92
1 SUBROUTINE PKBS1(IVAL,MBAY,S1MNEM)
3 C$$$ SUBPROGRAM DOCUMENTATION BLOCK
5 C SUBPROGRAM: PKBS1
6 C PRGMMR: J. ATOR ORG: NP12 DATE: 2005-11-29
8 C ABSTRACT: THIS SUBROUTINE STORES A SPECIFIED INTEGER VALUE INTO A
9 C SPECIFIED LOCATION WITHIN SECTION 1 OF THE BUFR MESSAGE STORED IN
10 C ARRAY MBAY, OVERWRITING THE VALUE PREVIOUSLY STORED AT THAT
11 C LOCATION. IT WILL WORK ON ANY MESSAGE ENCODED USING BUFR EDITION
12 C 2, 3 OR 4. THE START OF THE BUFR MESSAGE (I.E. THE STRING "BUFR")
13 C MUST BE ALIGNED ON THE FIRST FOUR BYTES OF MBAY, AND THE LOCATION
14 C WITHIN WHICH TO STORE THE VALUE IS SPECIFIED VIA THE MNEMONIC
15 C S1MNEM, AS EXPLAINED IN FURTHER DETAIL BELOW.
17 C PROGRAM HISTORY LOG:
18 C 2005-11-29 J. ATOR -- ORIGINAL AUTHOR
19 C 2006-04-14 D. KEYSER -- ADDED OPTIONS FOR 'MTYP', 'MSBT', 'YEAR',
20 C 'MNTH', 'DAYS', 'HOUR', 'YCEN' AND 'CENT'
22 C USAGE: PKBS1 (IVAL, MBAY, S1MNEM)
23 C INPUT ARGUMENT LIST:
24 C IVAL - INTEGER: VALUE TO BE STORED
25 C MBAY - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING
26 C BUFR MESSAGE PRIOR TO STORING IVAL
27 C S1MNEM - CHARACTER*(*): MNEMONIC SPECIFYING LOCATION WHERE IVAL
28 C IS TO BE STORED WITHIN SECTION 1 OF BUFR MESSAGE:
29 C 'BMT' = BUFR MASTER TABLE
30 C 'OGCE' = ORIGINATING CENTER
31 C 'GSES' = ORIGINATING SUBCENTER
32 C (NOTE: THIS VALUE IS STORED ONLY IN
33 C BUFR EDITION 3 OR 4 MESSAGES!)
34 C 'USN' = UPDATE SEQUENCE NUMBER
35 C 'MTYP' = DATA CATEGORY
36 C 'MSBTI' = DATA SUBCATEGORY (INTERNATIONAL)
37 C (NOTE: THIS VALUE IS STORED ONLY IN
38 C BUFR EDITION 4 MESSAGES!)
39 C 'MSBT' = DATA SUBCATEGORY (LOCAL)
40 C 'MTV' = VERSION NUMBER OF MASTER TABLE
41 C 'MTVL' = VERSION NUMBER OF LOCAL TABLES
42 C 'YCEN' = YEAR OF CENTURY (1-100)
43 C (NOTE: THIS VALUE IS STORED ONLY IN
44 C BUFR EDITION 2 AND 3 MESSAGES!)
45 C 'CENT' = CENTURY (I.E., 20 FOR YEARS 1901-2000,
46 C 21 FOR YEARS 2001-2100)
47 C (NOTE: THIS VALUE IS STORED ONLY IN
48 C BUFR EDITION 2 AND 3 MESSAGES!)
49 C 'YEAR' = YEAR (4-DIGIT)
50 C (NOTE: THIS VALUE IS STORED ONLY IN
51 C BUFR EDITION 4 MESSAGES!)
52 C 'MNTH' = MONTH
53 C 'DAYS' = DAY
54 C 'HOUR' = HOUR
55 C 'MINU' = MINUTE
56 C 'SECO' = SECOND
57 C (NOTE: THIS VALUE IS STORED ONLY IN
58 C BUFR EDITION 4 MESSAGES!)
60 C OUTPUT ARGUMENT LIST:
61 C MBAY - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING BUFR
62 C MESSAGE WITH IVAL NOW STORED AS REQUESTED
64 C REMARKS:
65 C THIS ROUTINE CALLS: BORT GETS1LOC IUPBS01 PKB
66 C THIS ROUTINE IS CALLED BY: MINIMG MSGWRT
67 C Also called by application programs.
69 C ATTRIBUTES:
70 C LANGUAGE: FORTRAN 77
71 C MACHINE: PORTABLE TO ALL PLATFORMS
73 C$$$
75 DIMENSION MBAY(*)
77 CHARACTER*(*) S1MNEM
79 CHARACTER*128 BORT_STR
81 C-----------------------------------------------------------------------
82 C-----------------------------------------------------------------------
84 C Note that the following call to function IUPBS01 will ensure
85 C that subroutine WRDLEN has been called.
87 IBEN = IUPBS01(MBAY,'BEN')
89 C Determine where to store the value.
91 CALL GETS1LOC(S1MNEM,IBEN,ISBYT,IWID,IRET)
92 IF ( (IRET.EQ.0) .AND.
93 . ( (S1MNEM.EQ.'USN') .OR. (S1MNEM.EQ.'BMT') .OR.
94 . (S1MNEM.EQ.'OGCE') .OR. (S1MNEM.EQ.'GSES') .OR.
95 . (S1MNEM.EQ.'MTYP') .OR. (S1MNEM.EQ.'MSBTI') .OR.
96 . (S1MNEM.EQ.'MSBT') .OR. (S1MNEM.EQ.'MTV') .OR.
97 . (S1MNEM.EQ.'MTVL') .OR. (S1MNEM.EQ.'YCEN') .OR.
98 . (S1MNEM.EQ.'CENT') .OR. (S1MNEM.EQ.'YEAR') .OR.
99 . (S1MNEM.EQ.'MNTH') .OR. (S1MNEM.EQ.'DAYS') .OR.
100 . (S1MNEM.EQ.'HOUR') .OR. (S1MNEM.EQ.'MINU') .OR.
101 . (S1MNEM.EQ.'SECO') ) ) THEN
103 C Store the value.
105 IBIT = (IUPBS01(MBAY,'LEN0')+ISBYT-1)*8
106 CALL PKB(IVAL,IWID,MBAY,IBIT)
107 ELSE
108 GOTO 900
109 ENDIF
111 RETURN
112 900 WRITE(BORT_STR,'("BUFRLIB: PKBS1 - CANNOT OVERWRITE LOCATION '//
113 . 'CORRESPONDING TO MNEMONIC (",A,") WITHIN BUFR EDITION '//
114 . '(",I1,")")') S1MNEM, IBEN
115 CALL BORT(BORT_STR)