NCEPLIBS-w3emc  2.11.0
w3fp11.f
Go to the documentation of this file.
1 C> @file
2 C> @brief One-line GRIB titler from pds section.
3 C> @author Ralph Jones @date 1991-06-19
4 
5 C> Converts GRIB formatted product definition section version
6 C> 1 to a one line readable title. GRIB section 0 is also tested to
7 C> verify that GRIB data is being deciphered.
8 C>
9 C> ### Program History Log:
10 C> Date | Programmer | Comments
11 C> -----|------------|---------
12 C> 1991-06-19 | Ralph Jones | Initial
13 C> 1992-05-29 | Ralph Jones | Add water temp to tables
14 C> 1993-01-19 | Ralph Jones | Add montgomary stream function to tables. add code for surface value 113. add condensation pressure to tables
15 C> 1993-02-19 | Ralph Jones | Add cape and tke (157 & 158) to tables
16 C> 1993-02-24 | Ralph Jones | Add GRIB type pmsle (130) to tables
17 C> 1993-03-26 | Ralph Jones | Add GRIB type sglyr (175) to tables
18 C> 1993-03-27 | Ralph Jones | Changes for revised o.n.388 mar. 3,1993
19 C> 1993-03-29 | Ralph Jones | Add save statement
20 C> 1993-04-16 | Ralph Jones | Add GRIB type lat, lon (176,177) to tables
21 C> 1993-04-25 | Ralph Jones | Add GRIB type 204, 205, 211, 212, 218
22 C> 1993-05-18 | Ralph Jones | Add test for model 70
23 C> 1993-06-26 | Ralph Jones | Add GRIB type 128, 129, take out test for MODEL 86.
24 C> 1993-08-07 | Ralph Jones | Add GRIB type 156 (cin), 150 (cbmzw), 151 (cbtzw), 152 (cbtmw) to tables.
25 C> 1993-10-14 | Ralph Jones | Change for o.n. 388 rev. oct. 8,1993
26 C> 1993-10-29 | Ralph Jones | Change for 'l cdc' 'm cdc' 'h cdc'
27 C> 1993-10-14 | Ralph Jones | Change for o.n. 388 rev. nov. 19,1993
28 C> 1994-02-05 | Ralph Jones | Change for o.n. 388 rev. dec. 14,1993. add model number 86 and 87.
29 C> 1994-03-24 | Ralph Jones | Add GRIB type 24 (toto3), 206 (uvpi)
30 C> 1994-06-04 | Ralph Jones | Change uvpi to uvi
31 C> 1994-06-16 | Ralph Jones | Add GRIB type 144,145,146,147,148,149 soilw,pevpr,cwork,u-gwd,v-gwd,pv to tables.
32 C> 1994-06-22 | Ralph Jones | Add ncar (60) to centers
33 C> 1994-07-25 | Ralph Jones | Correction for 71, 72, 213 (t cdc), (cdcon), (cdlyr)
34 C> 1994-10-27 | Ralph Jones | Add GRIB type 191 (prob), 192 (probn), add test for model 90, 91, 92, 93, add sub center 2.
35 C> 1995-02-09 | Ralph Jones | Correction for century for fnoc
36 C> 1995-04-11 | Ralph Jones | Correction for lmh and lmv
37 C> 1995-06-20 | Ralph Jones | Add GRIB type 189 (vstm), 190 (hlcy), 193 (pop), 194 (cpofp), 195 (cpozp), 196 (ustm), 197 (vstm) to tables.
38 C> 1995-08-07 | Ralph Jones | Add GRIB type 153 (clwmr), 154 (o3mr), 221 (hpbl), 237 (o3tot).
39 C> 1995-09-07 | Ralph Jones | Take out GRIB type 24 (toto3), change to GRIB type 10 (tozne). add level 117, potential vortiticity (pv) level, add eta
40 C> ^ | ^ | Level 119, add 120 layer betwwen two eta levels. change name of level 107 to (sigl), change name of level 108 to (sigy).
41 C> 1995-09-26 | Ralph Jones | Add level 204 (htfl) highest tropsphere freezing level.
42 C> 1995-10-19 | Ralph Jones | Change some of the level abreviations.
43 C> 1995-12-13 | Ralph Jones | Add 8 sub-centers to tables
44 C> 1996-03-04 | Ralph Jones | Changes for o.n. 388 jan 2, 1996
45 C> 1996-03-22 | Ralph Jones | Change scusf to csusf
46 C> 1996-10-01 | Mark Iredell | Recognize forecast time units 1 to 12 and correct for year 2000
47 C> 1996-10-31 | Ralph Jones | Change array and table for ics1 to 10.
48 C> 1996-10-01 | Mark Iredell | Allow parameter table version up to 127
49 C> 1998-05-26 | Stephen Gilbert | Added 17 new parameters ( GRIB table 2 ). added 6 new special levels for clouds. added subcenter 11 (tdl) under center 7 (ncep)
50 C> 1998-12-21 | Stephen Gilbert | Replaced function ichar with mova2i.
51 C> 1901-01-05 | Boi Vuong | Add level 247 (ehlt) equilibrium level
52 C> 1902-05-01 | Boi Vuong | Changes for o.n. 388 mar 21, 2002
53 C> 1902-03-25 | Boi Vuong | Add GRIB table version 129 and 130
54 C> 1903-07-02 | Stephen Gilbert | Added 5 new params to table version 129
55 C> 1904-14-04 | Boi Vuong | Add GRIB table version 131 and added 12 new parameter to table version 129
56 C> 1904-08-09 | Boi Vuong | Add parameter (thflx) to table version 129
57 C> 1905-02-08 | Cooke | Corrected entry for freezing rain, crfzr to cfrzr in the hhnam1 array
58 C> 1906-08-11 | Boi Vuong | Add levels (235,236,237,238,240,245) and added new parameters to table version 129 and added
59 C> ^ | ^ | One parameter 154 to table version 130 and added table version 128
60 C> 1907-04-05 | Boi Vuong | Add parameters to table version 128, 129 and 130
61 C> 1907-05-15 | Boi Vuong | Added time range indicator 51 and new table 140
62 C>
63 C> @param[in] IPDS0 GRIB section 0 read as character*8
64 C> @param[in] IPDS GRIB pds section read as character*28
65 C> @param[out] TITL Character*86 output print line
66 C> @param[out] IERR
67 C> 0 - Completed satisfactorily
68 C> 1 - GRIB section 0, can not find 'GRIB'
69 C> 2 - GRIB is not version 1
70 C> 3 - Length of pds section is less than 28
71 C> 4 - Could not match type indicator
72 C> 5 - Could not match type level
73 C> 6 - Could not interpret originator of code
74 C> 7 - Could not interpret sub center 7 originator of code
75 C> 8 - Could not interpret sub center 9 originator of code
76 C> 9 - Parameter table version not 1 or 2
77 C>
78  SUBROUTINE w3fp11 (IPDS0, IPDS, TITL, IERR)
79  INTEGER CENTER(17)
80  INTEGER SCNTR1(16)
81  INTEGER SCNTR2(14)
82  INTEGER FCSTIM
83  INTEGER HH(252)
84  INTEGER HH1(105)
85  INTEGER HH2(105)
86  INTEGER HH3(42)
87  INTEGER HH128(72)
88  INTEGER HH129(98)
89  INTEGER HH130(112)
90  INTEGER HH131(241)
91  INTEGER HH140(112)
92  INTEGER HHH(73)
93  INTEGER IERR
94  INTEGER P1
95  INTEGER P2
96  INTEGER TIMERG
97 C
98  CHARACTER * 6 HHNAM(252)
99  CHARACTER * 6 HHNAM1(105)
100  CHARACTER * 6 HHNAM2(105)
101  CHARACTER * 6 HHNAM3(42)
102  CHARACTER * 6 HHNAM128(72)
103  CHARACTER * 6 HHNAM129(98)
104  CHARACTER * 6 HHNAM130(112)
105  CHARACTER * 6 HHNAM140(112)
106  CHARACTER * 6 HHNAM131(241)
107  CHARACTER * 4 HHHNAM(73)
108  CHARACTER * (*) IPDS
109  CHARACTER * 8 IPDS0
110  CHARACTER * 28 IDPDS
111  CHARACTER * 4 GRIB
112  CHARACTER * 28 KNAM1(17)
113  CHARACTER * 28 KNAM2(16)
114  CHARACTER * 28 KNAM3(14)
115  CHARACTER * 3 MONTH(12)
116  CHARACTER * 4 TIMUN(12)
117  CHARACTER * 2 TIMUN1(12)
118  CHARACTER * 86 TITL
119 C
120  equivalence(hh(1),hh1(1))
121  equivalence(hh(106),hh2(1))
122  equivalence(hh(211),hh3(1))
123  equivalence(hhnam(1),hhnam1(1))
124  equivalence(hhnam(106),hhnam2(1))
125  equivalence(hhnam(211),hhnam3(1))
126 C
127  SAVE
128 C
129  DATA center/ 7, 8, 9, 34, 52, 54, 57,
130  & 58, 59, 60, 61, 62, 74, 85,
131  & 97, 98, 99/
132 C
133 C TABLE 3 - TYPE AND VALUE OF LEVELS (PDS OCTETS 10, 11 AND 12)
134 C
135  DATA hhh / 1, 2, 3, 4, 5, 6, 7,
136  & 8, 9, 20, 100, 101, 102, 103,
137  & 104, 105, 106, 107, 108, 109, 110,
138  & 111, 112, 113, 114, 115, 116, 117,
139  & 119, 120, 121, 125, 126, 128, 141,
140  & 160, 200, 201, 204, 212, 213, 214,
141  & 222, 223, 224, 232, 233, 234, 209,
142  & 210, 211, 242, 243, 244, 246, 247,
143  & 206, 207, 248, 249, 251, 252, 235,
144  & 236, 237, 238, 215, 220, 239, 240,
145  & 245, 253, 254/
146  DATA hhhnam/'SFC ','CBL ','CTL ','0DEG','ADCL','MWSL','TRO ',
147  & 'NTAT','SEAB','TMPL','ISBL','ISBY','MSL ','GPML',
148  & 'GPMY','HTGL','HTGY','SIGL','SIGY','HYBL','HYBY',
149  & 'DBLL','DBLY','THEL','THEY','SPDL','SPDY','PVL ',
150  & 'ETAL','ETAY','IBYH','HGLH','ISBP','SGYH','IBYM',
151  & 'DBSL','EATM','EOCN','HTFL','LCBL','LCTL','LCY ',
152  & 'MCBL','MCTL','MCY ','HCBL','HCTL','HCY ','BCBL',
153  & 'BCTL','BCY ','CCBL','CCTL','CCY ','MTHE','EHLT',
154  & 'GCBL','GCTL','SCBL','SCTL','DCBL','DCTL','OITL',
155  & 'OLYR','OBML','OBIL','CEIL','PBLR','S26C','OMXL',
156  & 'LLTW','LBLS','HTLS'/
157 C
158 C GRIB TABLE VERSION 2 (PDS OCTET 4 = 2)
159 C
160  DATA hh1 /
161  & 1, 2, 3, 5, 6, 7, 8,
162  & 9, 10, 11, 12, 13, 14, 15,
163  & 16, 17, 18, 19, 20, 21, 22,
164  & 23, 24, 25, 26, 27, 28, 29,
165  & 30, 31, 32, 33, 34, 35, 36,
166  & 37, 38, 39, 40, 41, 42, 43,
167  & 44, 45, 46, 47, 48, 49, 50,
168  & 51, 52, 53, 54, 55, 56, 57,
169  & 58, 59, 60, 61, 62, 63, 64,
170  & 65, 66, 67, 68, 69, 70, 71,
171  & 72, 73, 74, 75, 76, 77, 78,
172  & 79, 80, 81, 82, 83, 84, 85,
173  & 86, 87, 88, 89, 90, 91, 92,
174  & 93, 94, 95, 96, 97, 98, 99,
175  & 100, 101, 102, 103, 104, 105, 106/
176  DATA hh2 /
177  & 107, 108, 109, 110, 111, 112, 113,
178  & 114, 115, 116, 117, 121, 122, 123,
179  & 124, 125, 126, 127, 128, 129, 130,
180  & 131, 132, 133, 134, 135, 136, 137,
181  & 138, 139, 140, 141, 142, 143, 144,
182  & 145, 146, 147, 148, 149, 150, 151,
183  & 152, 153, 154, 155, 156, 157, 158,
184  & 159, 160, 161, 162, 163, 164, 165,
185  & 166, 167, 168, 169, 172, 173, 174,
186  & 175, 176, 177, 181, 182, 183, 184,
187  & 189, 190, 191, 192, 193, 194, 195,
188  & 196, 197, 201, 204, 205, 206, 207,
189  & 208, 209, 211, 212, 213, 214, 215,
190  & 216, 217, 218, 219, 220 ,221, 222,
191  & 223, 226, 227, 228, 229, 231, 232/
192  DATA hh3 /
193  & 233, 234, 235, 237, 238, 239, 241,
194  & 242, 243, 244, 245, 246, 247, 248,
195  & 249, 250, 251, 252, 253, 254, 255,
196  & 4, 118, 119, 120, 170, 171, 178,
197  & 179, 185, 186, 187, 198, 199, 200,
198  & 224, 225, 230, 180, 202, 210, 240/
199  DATA hhnam1/
200  &' PRES ',' PRMSL',' PTEND',' ICAHT',' GP ',' HGT ',' DIST ',
201  &' HSTDV',' TOZNE',' TMP ',' VTMP ',' POT ',' EPOT ',' T MAX',
202  &' T MIN',' DPT ',' DEPR ',' LAPR ',' VIS ',' RDSP1',' RDSP2',
203  &' RDSP3',' PLI ',' TMP A',' PRESA',' GP A ',' WVSP1',' WVSP2',
204  &' WVSP3',' WDIR ',' WIND ',' U GRD',' V GRD',' STRM ',' V POT',
205  &' MNTSF',' SGCVV',' V VEL',' DZDT ',' ABS V',' ABS D',' REL V',
206  &' REL D',' VUCSH',' VVCSH',' DIR C',' SP C ',' UOGRD',' VOGRD',
207  &' SPF H',' R H ',' MIXR ',' P WAT',' VAPP ',' SAT D',' EVP ',
208  &' C ICE',' PRATE',' TSTM ',' A PCP',' NCPCP',' ACPCP',' SRWEQ',
209  &' WEASD',' SNO D',' MIXHT',' TTHDP',' MTHD ',' MTH A',' T CDC',
210  &' CDCON',' L CDC',' M CDC',' H CDC',' C WAT',' BLI ',' SNO C',
211  &' SNO L',' WTMP ',' LAND ',' DSL M',' SFC R',' ALBDO',' TSOIL',
212  &' SOILM',' VEG ',' SALTY',' DEN ',' WATR ',' ICE C',' ICETK',
213  &' DICED',' SICED',' U ICE',' V ICE',' ICE G',' ICE D',' SNO M',
214  &' HTSGW',' WVDIR',' WVHGT',' WVPER',' SWDIR',' SWELL',' SWPER'/
215  DATA hhnam2/
216  &' DIRPW',' PERPW',' DIRSW',' PERSW',' NSWRS',' NLWRS',' NSWRT',
217  &' NLWRT',' LWAVR',' SWAVR',' G RAD',' LHTFL',' SHTFL',' BLYDP',
218  &' U FLX',' V FLX',' WMIXE',' IMG D',' MSLSA',' MSLMA',' MSLET',
219  &' LFT X',' 4LFTX',' K X ',' S X ',' MCONV',' VW SH',' TSLSA',
220  &' BVF2 ',' PV MW',' CRAIN',' CFRZR',' CICEP',' CSNOW',' SOILW',
221  &' PEVPR',' CWORK',' U-GWD',' V-GWD',' PV ',' COVMZ',' COVTZ',
222  &' COVTM',' CLWMR',' O3MR ',' GFLUX',' CIN ',' CAPE ',' TKE ',
223  &' CONDP',' CSUSF',' CSDSF',' CSULF',' CSDLF',' CFNSF',' CFNLF',
224  &' VBDSF',' VDDSF',' NBDSF',' NDDSF',' M FLX',' LMH ',' LMV ',
225  &' MLYNO',' NLAT ',' ELON ',' LPS X',' LPS Y',' HGT X',' HGT Y',
226  &' VPTMP',' HLCY ',' PROB ',' PROBN',' POP ',' CPOFP',' CPOZP',
227  &' USTM ',' VSTM ',' ICWAT',' DSWRF',' DLWRF',' UVI ',' MSTAV',
228  &' SFEXC',' MIXLY',' USWRF',' ULWRF',' CDLYR',' CPRAT',' TTDIA',
229  &' TTRAD',' TTPHY',' PREIX',' TSD1D',' NLGSP',' HPBL ',' 5WAVH',
230  &' CNWAT',' BMIXL',' AMIXL',' PEVAP',' SNOHF',' MFLUX',' DTRF '/
231  DATA hhnam3/
232  &' UTRF ',' BGRUN',' SSRUN',' O3TOT',' SNOWC',' SNO T',' LRGHR',
233  &' CNVHR',' CNVMR',' SHAHR',' SHAMR',' VDFHR',' VDFUA',' VDFVA',
234  &' VDFMR',' SWHR ',' LWHR ',' CD ',' FRICV',' RI ',' MISS ',
235  &' PVORT',' BRTMP',' LWRAD',' SWRAD',' RWMR ',' SNMR ',' ICMR ',
236  &' GRMR ',' TURB ',' ICNG ',' LTNG ',' NCIP ',' EVBS ',' EVCW ',
237  &' SOTYP',' VGTYP',' 5WAVA',' GUST ',' CWDI ',' TRANS',' COVTW'/
238 C
239 C GRIB TABLE VERSION 128 (PDS OCTET 4 = 128)
240 C ( OCEANGRAPHIC PARAMETER )
241 C
242  DATA hh128/
243  & 128, 129, 130, 131, 132, 133, 134,
244  & 135, 136, 137, 138, 139, 140, 141,
245  & 142, 143, 144, 145, 146, 147, 148,
246  & 149, 150, 151, 152, 153, 154, 155,
247  & 156, 157, 158, 159, 160, 161, 162,
248  & 163, 164, 165, 166, 167, 168, 169,
249  & 170, 171, 172, 173, 174, 175, 176,
250  & 177, 178, 179, 180, 181, 182, 183,
251  & 184, 185, 186, 187, 188, 189, 190,
252  & 191, 192, 193, 194, 254, 40, 41,
253  & 42, 43/
254  DATA hhnam128/
255  &'ADEPTH',' DEPTH',' ELEV ','MXEL24','MNEL24',' ',' ',
256  &' O2 ',' PO4 ',' NO3 ',' SIO4 ',' CO2AQ',' HCO3 ',' CO3 ',
257  &' TCO2 ',' TALK ',' ',' ',' S11 ',' S12 ',' S22 ',
258  &' INV1 ',' INV2 ',' ',' ',' ',' ',' WVRGH',
259  &'WVSTRS',' WHITE','SWDIRW','SWFREW',' WVAGE','PWVAGE',' ',
260  &' ',' ',' LTURB',' ',' ',' ',' ',
261  &'AIHFLX','AOHFLX','IOHFLX','IOSFLX',' ',' OMLT ',' OMLS ',
262  &'P2OMLT',' OMLU ',' OMLV ',' ASHFL',' ASSFL',' BOTLD',' UBARO',
263  &' VBARO',' INTFD',' WTMPC',' SALIN',' EMNP ',' ',' KENG ',
264  &' ',' LAYTH',' SSTT ',' SSST ',' ','A RAIN','A SNOW',
265  &'A ICE ','A FRZR'/
266 C
267 C GRIB TABLE VERSION 129 (PDS OCTET 4 = 129)
268 C
269  DATA hh129/
270  & 128, 129, 130, 131, 132, 133, 134,
271  & 135, 136, 137, 138, 139, 140, 141,
272  & 142, 143, 144, 145, 146, 147, 148,
273  & 149, 150, 151, 152, 153, 154, 155,
274  & 156, 157, 158, 159, 160, 161, 162,
275  & 163, 164, 165, 166, 167, 168, 169,
276  & 170, 171, 172, 173, 174, 175, 176,
277  & 177, 178, 179, 180, 181, 182, 183,
278  & 184, 185, 186, 187, 188, 189, 190,
279  & 191, 192, 193, 194, 195, 196, 197,
280  & 198, 199, 200, 201, 201, 203, 204,
281  & 205, 206, 207, 208, 209, 210, 211,
282  & 212, 213, 214, 215, 216, 217, 218,
283  & 219, 220, 221, 222, 223, 224, 225/
284  DATA hhnam129/
285  &' PAOT ',' PAOP ',' ',' FRAIN',' FICE ',' FRIME',' CUEFI',
286  &' TCOND',' TCOLW',' TCOLI',' TCOLR',' TCOLS',' TCOLC',' PLPL ',
287  &' HLPL ',' CEMS ',' COPD ',' PSIZ ',' TCWAT',' TCICE',' WDIF ',
288  &' WSTP ',' PTAN ',' PTNN ',' PTBN ',' PPAN ',' PPNN ',' PPBN ',
289  &' PMTC ',' PMTF ',' AETMP',' AEDPT',' AESPH',' AEUWD',' AEVWD',
290  &' LPMTF',' LIPMF',' REFZR',' REFZI',' REFZC',' TCLSW',' TCOLM',
291  &' ELRDI',' TSEC ',' TSECA',' NUM ',' AEPRS',' ICSEV',' ICPRB',
292  &' LAVNI',' HAVNI',' FLGHT',' OZCON',' OZCAT',' VEDH ',' SIGV ',
293  &' EWGT ',' CICEL',' CIVIS',' CIFLT',' LAVV ',' LOVV ',' USCT ',
294  &' VSCT ',' LAUV ',' LOUV ',' TCHP ',' DBSS ',' ODHA ',' OHC ',
295  &' SSHG ',' SLTFL',' DUVB ',' CDUVB',' THFLX',' UVAR ',' VVAR ',
296  &'UVVCC ',' MCLS ',' LAPP ',' LOPP ',' ',' REFO ',' REFD ',
297  &' REFC ','SBT122','SBT123','SBT124','SBT125',' MINRH',' MAXRH',
298  &' CEIL ','PBLREG',' ',' ',' ',' ',' '/
299 C
300 C GRIB TABLE VERSION 130 (PDS OCTET 4 = 130)
301 C ( FOR LAND MODELING AND LAND DATA ASSIMILATION )
302 C
303  DATA hh130/
304  & 144, 145, 146, 147, 148, 149, 150,
305  & 151, 152, 153, 154, 155, 156, 157,
306  & 158, 159, 160, 161, 162, 163, 164,
307  & 165, 166, 167, 168, 169, 170, 171,
308  & 172, 173, 174, 175, 176, 177, 178,
309  & 179, 180, 181, 182, 183, 184, 185,
310  & 186, 187, 188, 189, 190, 191, 192,
311  & 193, 194, 195, 196, 197, 198, 199,
312  & 200, 201, 202, 203, 204, 205, 206,
313  & 207, 208, 209, 210, 211, 212, 213,
314  & 214, 215, 216, 217, 218, 219, 220,
315  & 221, 222, 223, 224, 225, 226, 227,
316  & 228, 229, 230, 231, 232, 233, 234,
317  & 235, 236, 237, 238, 239, 240, 241,
318  & 242, 243, 244, 245, 246, 247, 248,
319  & 249, 250, 251, 252, 253, 254, 255/
320  DATA hhnam130/
321  &' SOIL ',' PEVPR',' VEGT ',' BARET',' AVSFT',' RADT ',' SSTOR',
322  &' LSOIL',' EWATR',' ',' LSPA ',' GFLUX',' CIN ',' CAPE ',
323  &' TKE ','MXSALB',' SOILL',' ASNOW',' ARAIN',' GWREC',' QREC ',
324  &' SNOWT',' VBDSF',' VDDSF',' NBDSF',' NDDSF','SNFALB',' ',
325  &' M FLX',' ',' ',' ',' NLAT ',' ELON ','FLDCAP',
326  &' ACOND',' SNOAG',' CCOND',' LAI ',' SFCRH',' SALBD',' ',
327  &' ',' NDVI ',' DRIP ','VBSLAB','VWSALB','NBSALB','NWSALB',
328  &' ',' ',' ',' ',' ',' SBSNO',' EVBS ',
329  &' EVCW ',' ',' ',' RSMIN',' DSWRF',' DLWRF',' ',
330  &' MSTAV',' SFEXC',' ',' TRANS',' USWRF',' ULWRF',' ',
331  &' ',' ',' ',' ',' ',' WILT ',' FLDCP',
332  &' HPBL ',' SLTYP',' CNWAT',' SOTYP',' VGTYP',' BMIXL',' AMIXL',
333  &' PEVAP',' SNOHF',' SMREF',' SMDRY',' ',' ',' BGRUN',
334  &' SSRUN',' ',' ',' SNOWC',' SNOT ',' POROS',' ',
335  &' ',' ',' ',' ',' RCS ',' RCT ',' RCQ ',
336  &' RCSOL',' ',' ',' CD ',' FRICV',' RI ',' '/
337 C
338 C GRIB TABLE VERSION 140 (PDS OCTET 4 = 140)
339 C ( FOR WORLD AREA FORECAST SYSTEM (WAF/ICAO)
340 C
341  DATA hh140/
342  & 144, 145, 146, 147, 148, 149, 150,
343  & 151, 152, 153, 154, 155, 156, 157,
344  & 158, 159, 160, 161, 162, 163, 164,
345  & 165, 166, 167, 168, 169, 170, 171,
346  & 172, 173, 174, 175, 176, 177, 178,
347  & 179, 180, 181, 182, 183, 184, 185,
348  & 186, 187, 188, 189, 190, 191, 192,
349  & 193, 194, 195, 196, 197, 198, 199,
350  & 200, 201, 202, 203, 204, 205, 206,
351  & 207, 208, 209, 210, 211, 212, 213,
352  & 214, 215, 216, 217, 218, 219, 220,
353  & 221, 222, 223, 224, 225, 226, 227,
354  & 228, 229, 230, 231, 232, 233, 234,
355  & 235, 236, 237, 238, 239, 240, 241,
356  & 242, 243, 244, 245, 246, 247, 248,
357  & 249, 250, 251, 252, 253, 254, 255/
358  DATA hhnam140/
359  &' ',' ',' ',' ',' ',' ',' ',
360  &' ',' ',' ',' ',' ',' ',' ',
361  &' ',' ',' ',' ',' ',' ',' ',
362  &' ',' ',' ',' ',' ',' ',' ',
363  &' ',' ',' ',' MEIP ',' MAIP ',' MECTP',' MACTP',
364  &' MECAT',' MACAT',' CBHE ',' PCBB ',' PCBT ',' PECBB',' PECBT',
365  &' HCBB ',' HCBT ',' HECBB',' HECBT',' ',' ',' ',
366  &' ',' ',' ',' ',' ',' ',' ',
367  &' ',' ',' ',' ',' ',' ',' ',
368  &' ',' ',' ',' ',' ',' ',' ',
369  &' ',' ',' ',' ',' ',' ',' ',
370  &' ',' ',' ',' ',' ',' ',' ',
371  &' ',' ',' ',' ',' ',' ',' ',
372  &' ',' ',' ',' ',' ',' ',' ',
373  &' ',' ',' ',' ',' ',' ',' ',
374  &' ',' ',' ',' ',' ',' ',' MISS '/
375 C
376 C GRIB TABLE VERSION 131 (PDS OCTET 4 = 131)
377 C
378  DATA hh131/
379  & 1, 2, 3, 4, 5, 6, 7,
380  & 8, 9, 10, 11, 12, 13, 14,
381  & 15, 16, 17, 18, 19, 20, 21,
382  & 22, 23, 24, 25, 26, 27, 28,
383  & 29, 30, 31, 32, 33, 34, 35,
384  & 36, 37, 38, 39, 40, 41, 42,
385  & 43, 44, 45, 46, 47, 48, 49,
386  & 50, 51, 52, 53, 54, 55, 56,
387  & 57, 58, 59, 60, 61, 62, 63,
388  & 64, 65, 66, 67, 68, 69, 70,
389  & 71, 72, 73, 74, 75, 76, 77,
390  & 78, 79, 80, 81, 82, 83, 84,
391  & 85, 86, 87, 88, 89, 90, 91,
392  & 92, 93, 94, 95, 96, 97, 98,
393  & 99, 100, 101, 102, 103, 104, 105,
394  & 106, 107, 108, 109, 110, 111, 112,
395  & 113, 114, 115, 116, 117, 118, 119,
396  & 120, 121, 122, 123, 124, 125, 126,
397  & 127, 128, 130, 131, 132, 134, 135,
398  & 136, 139, 140, 141, 142, 143, 144,
399  & 145, 146, 147, 148, 149, 150, 151,
400  & 152, 153, 155, 156, 157, 158, 159,
401  & 160, 161, 162, 163, 164, 165, 166,
402  & 167, 168, 169, 170, 171, 172, 173,
403  & 174, 175, 176, 177, 178, 179, 180,
404  & 181, 182, 183, 184, 187, 188, 189,
405  & 190, 191, 192, 194, 196, 197, 198,
406  & 199, 200, 202, 203, 204, 205, 206,
407  & 207, 208, 210, 211, 212, 213, 214,
408  & 216, 218, 219, 220, 221, 222, 223,
409  & 224, 225, 226, 227, 228, 229, 230,
410  & 231, 232, 233, 234, 235, 237, 238,
411  & 239, 240, 241, 242, 243, 244, 245,
412  & 246, 247, 248, 249, 250, 251, 252,
413  & 253, 254, 255/
414  DATA hhnam131/
415  &' PRES ',' PRMSL',' PTEND',' PVORT',' ICAHT',' GP ',' HGT ',
416  &' DIST ',' HSTDV',' TOZNE',' TMP ',' VTMP ',' POT ',' EPOT ',
417  &' TMAX ',' TMIN ',' DPT ',' DEPR ',' LAPR ',' VIS ',' RDSP1',
418  &' RDSP2',' RDSP3',' PLI ',' TMPA ',' PRESA',' GPA ',' WVSP1',
419  &' WVSP2',' WVSP3',' WDIR ',' WIND ',' UGRD ',' VGRD ',' STRM ',
420  &' VPOT ',' MNTSF',' SGVCC',' VVEL ',' DZDT ',' ABSV ',' ABSD ',
421  &' RELV ',' RELD ',' VUCSH',' VVCSH',' DIRC ',' SPC ',' UOGRD',
422  &' VOGRD',' SPFH ',' RH ',' MIXR ',' PWAT ',' VAPP ',' SATD ',
423  &' EVP ',' CICE ',' PRATE',' TSTM ',' APCP ',' NCPCP',' ACPCP',
424  &' SRWEQ',' WEASD',' SNOD ',' MIXHT',' TTHDP',' MTHD ',' MTHA ',
425  &' TCDC ',' CDCON',' LCDC ',' MCDC ',' HCDC ',' CWAT ',' BLI ',
426  &' SNOC ',' SNOL ',' WTMP ',' LAND ',' DSLM ',' SFCR ',' ALBDO',
427  &' TSOIL',' SOILM',' VEG ',' SALTY',' DEN ',' WATR ',' ICEC ',
428  &' ICETK',' DICED',' SICED',' UICE ',' VICE ',' ICEG ',' ICED ',
429  &' SNOM ',' HTSGW',' WVDIR',' WVHGT',' WVPER',' SWDIR',' SWELL',
430  &' SWPER',' DIRPW',' PERPW',' DIRSW',' PERSW',' NSWRS',' NLWRS',
431  &' NSWRT',' NLWRT',' LWAVR',' SWAVR',' GRAD ',' BRTMP',' LWRAD',
432  &' SWRAT',' LHTFL',' SHTFL',' BLYDP',' UFLX ',' VFLX ',' WMIXE',
433  &' IMGD ',' MSLSA',' MSLET',' LFTX ',' 4LFTX',' PRESN',' MCONV',
434  &' VWSH ',' PVMW ',' CRAIN',' CFRZR',' CICEP',' CSNOW',' SOILW',
435  &' PEVPR',' VEGT ',' BARET',' AVSFT',' RADT ',' SSTOR',' LSOIL',
436  &' EWATR',' CLWMR',' GFLUX',' CIN ',' CAPE ',' TKE ','MXSALB',
437  &' SOILL',' ASNOW',' ARAIN',' GWREC',' QREC ',' SNOWT',' VBDSF',
438  &' VDDSF',' NBDSF',' NDDSF','SNFALB',' RLYRS',' FLX ',' LMH ',
439  &' LMV ',' MLYNO',' NLAT ',' ELON ',' ICMR ',' ACOND',' SNOAG',
440  &' CCOND',' LAI ',' SFCRH',' SALBD',' NDVI ',' DRIP ',' LANDN',
441  &' HLCY ',' NLATN',' ELONN',' CPOFP',' USTM ',' VSTM ',' SBSNO',
442  &' EVBS ',' EVCW ',' APCPN',' RSMIN',' DSWRF',' DLWRF','ACPCPN',
443  &' MSTAV',' SFEXC',' TRANS',' USWRF',' ULWRF',' CDLYR',' CPRAT',
444  &' TTRAD',' HGTN ',' WILT ',' FLDCP',' HPBL ',' SLTYP',' CNWAT',
445  &' SOTYP',' VGTYP',' BMIXL',' AMIXL',' PEVAP',' SNOHF',' SMREF',
446  &' SMDRY',' WVINC',' WCINC',' BGRUN',' SSRUN','MVCONV',' SNOWC',
447  &' SNOT ',' POROS','WCCONV','WVUFLX','WVVFLX','WCUFLX','WCVFLX',
448  &' RCS ',' RCT ',' RCQ ',' RCSOL',' SWHR ',' LWHR ',' CD ',
449  &' FRICV',' RI ',' MISS '/
450 C
451 C ONE LINE CHANGE FOR HDS (IBM370) (ASCII NAME GRIB IN HEX)
452 C
453 C DATA GRIB /Z47524942/
454 C
455 C ONE LINE CHANGE FOR CRAY AND WORKSTATIONS
456 C
457  DATA grib /'GRIB'/
458 C
459 C TABLE O (PDS OCTET 5) NATIONAL/INTERNATIONAL
460 C ORIGINATING CENTERS
461 C
462  DATA knam1 /
463  & ' US NWS - NCEP (WMC) ',' US NWS - NWSTG (WMC) ',
464  & ' US NWS - Other (WMC)',' JMA - Tokyo (RSMC) ',
465  & ' TPC (NHC),Miami(RSMC)',' CMS - Montreal (RSMC)',
466  & ' U.S. Air Force - GWC ',' U.S. Navy - FNOC ',
467  & ' NOAA FSL, Boulder, CO',' NCAR, Boulder, CO ',
468  & ' SARGO, Landover, MD ',' US Naval, Oceanograph',
469  & ' U.K Met. Office RSMC)',' French WS - Toulouse ',
470  & ' European Space Agency',' ECMWF (RSMC) ',
471  & ' De Bilt, Netherlands '/
472 C
473 C TABLE C (PDS OCTET 26) NATIONAL SUB-CENTERS
474 C
475  DATA knam2 /
476  & ' NCEP RE-ANALYSIS PRO.',' NCEP ENSEMBLE PRODUCT',
477  & ' NCEP CENTRAL OPS. ',' ENV. MODELING CENTER ',
478  & ' HYDRO. PRED. CENTER ',' OCEAN PRED. CENTER ',
479  & ' CLIMATE PRED. CENTER ',' AVIATION WEATHER CEN.',
480  & ' STORM PRED. CENTER ',' TROPICAL PRED. CENTER',
481  & ' NWS TECH. DEV. LAB. ',' NESDIS OFF. RES. APP.',
482  & ' FAA ',' NWS MET. DEV. LAB. ',
483  & ' NARR PROJECT ',' SPACE ENV. CENTER '/
484  DATA knam3 /
485  & ' ABRFC TULSA, OK ',' AKRFC ANCHORAGE, AK ',
486  & ' CBRFC SALT LAKE, UT ',' CNRFC SACRAMENTO, CA',
487  & ' LMRFC SLIDEL, LA. ',' MARFC STATE CO., PA ',
488  & ' MBRFC KANSAS CITY MO',' NCRFC MINNEAPOLIS MN',
489  & ' NERFC HARTFORD, CT. ',' NWRFC PORTLAND, OR ',
490  & ' OHRFC CINCINNATI, OH',' SERFC ATLANTA, GA ',
491  & ' WGRFC FORT WORTH, TX',' OUN NORMAN OK WFO '/
492  DATA month /'JAN','FEB','MAR','APR','MAY','JUN',
493  & 'JUL','AUG','SEP','OCT','NOV','DEC'/
494  DATA scntr1/ 1, 2, 3, 4, 5, 6, 7,
495  & 8, 9, 10, 11, 12, 13, 14,
496  & 15, 16/
497  DATA scntr2/ 150, 151, 152, 153, 154, 155, 156,
498  & 157, 158, 159, 160, 161, 162, 170/
499  DATA timun /'HRS.','DAYS','MOS.','YRS.','DECS','NORM','CENS',
500  & 2*'----','3HRS','6HRS','HDYS'/
501  DATA timun1/'HR','DY','MO','YR','DC','NO','CN',
502  & 2*'--','3H','6H','HD'/
503 C
504 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
505 C
506 C 1.0 INITIALIZATION - NO. OF ENTRIES IN INDCATOR PARM.
507 C - NO. OF ENTRIES IN TYPE LEVEL
508 C - NO. OF ENTRIES IN CNTR PROD. DTA.
509 C - NO. OF ENTRIES IN SUB CNTR1 PROD. DTA.
510 C - NO. OF ENTRIES IN SUB CNTR2 PROD. DTA.
511 C
512  iq = 252
513  is = 73
514  ic = 17
515  ih128 = 72
516  ih129 = 98
517  ih130 = 112
518  ih140 = 112
519  ih131 = 241
520  ics1 = 16
521  ics2 = 14
522  ierr = 0
523 C
524  titl(1:30) = ' '
525  titl(31:60) = ' '
526  titl(61:86) = ' '
527 C
528 C ---------------------------------------------------------------------
529 C$ 2.0 TEST SECTION 0 FOR ASCII 'GRIB'
530 C
531  IF (grib(1:4) .NE. ipds0(1:4)) THEN
532  ierr = 1
533  RETURN
534  ENDIF
535 C
536 C TEST SECTION 0 FOR GRIB VERSION 1
537 C
538  IF (mova2i(ipds0(8:8)).NE.1) THEN
539  ierr = 2
540  RETURN
541  END IF
542 C
543 C TEST THE LENGTH OF THE PDS (SECTION 1)
544 C
545  lenpds = mova2i(ipds(1:1)) * 65536 + mova2i(ipds(2:2)) * 256 +
546  & mova2i(ipds(3:3))
547  IF (lenpds.GE.28) THEN
548  idpds(1:28) = ipds(1:28)
549  ELSE
550  ierr = 3
551  RETURN
552  ENDIF
553 C
554 C TEST PDS (OCTET 4) FOR PARAMETER TABLE VERSION
555 C NUMBER 1 OR 2 OR 128, 129 OR 130 OR 131 OR 140
556 C
557  iver = mova2i(idpds(4:4))
558  IF (iver.GT.131) THEN
559  ierr = 9
560  RETURN
561  END IF
562 C
563 C 4.0 FIND THE INDICATOR AND TYPE LEVELS
564 C
565  iqq = mova2i(idpds(9:9))
566  IF (iver.EQ.128) THEN
567  DO k = 1, ih128
568  IF (iqq .EQ. hh128(k)) THEN
569  titl(21:27) = hhnam128(k)
570  GO TO 150
571  END IF
572  END DO
573  ELSE IF (iver.EQ.129) THEN
574  DO k = 1, ih129
575  IF (iqq .EQ. hh129(k)) THEN
576  titl(21:27) = hhnam129(k)
577  GO TO 150
578  END IF
579  END DO
580  ELSE IF (iver.EQ.130) THEN
581  DO k = 1, ih130
582  IF (iqq .EQ. hh130(k)) THEN
583  titl(21:27) = hhnam130(k)
584  GO TO 150
585  END IF
586  END DO
587  ELSE IF (iver.EQ.131) THEN
588  DO k = 1, ih131
589  IF (iqq .EQ. hh131(k)) THEN
590  titl(21:27) = hhnam131(k)
591  GO TO 150
592  END IF
593  END DO
594  ELSE IF (iver.EQ.140) THEN
595  DO k = 1, ih140
596  IF (iqq .EQ. hh140(k)) THEN
597  titl(21:27) = hhnam140(k)
598  GO TO 150
599  END IF
600  END DO
601  ELSE
602  DO ii = 1,iq
603  IF (iqq .EQ. hh(ii)) GO TO 100
604  END DO
605  IF (iqq.EQ.77.AND.iver.EQ.1) GO TO 100
606  IF (iqq.EQ.24) GO TO 100
607  ierr = 4
608  RETURN
609  END IF
610 C
611  100 CONTINUE
612  IF (iqq .NE. 77 .AND. iqq .NE. 24) THEN
613  titl(21:27) = hhnam(ii)
614  ELSE IF (iqq .EQ. 77) THEN
615  titl(21:27) = ' CONDP '
616 C
617 C TAKE OUT AFTER ALL PROGRAMS ARE CHANGED THAT USE 24
618 C FOR TOTAL OZONE.
619 C
620  ELSE IF (iqq .EQ. 24) THEN
621  titl(21:27) = ' TOTO3 '
622  END IF
623  IF (iqq.EQ.137.AND.iver.EQ.1) titl(21:27) = ' VISIB '
624  150 CONTINUE
625  iss = mova2i(idpds(10:10))
626 C
627 C CORRECTION FOR 'NLAT' 'ELON' 'L CDC' 'M CDC', 'H CDC',
628 C 'T CDC'
629 C
630  IF (iss.EQ.0.AND.(iqq.EQ.176.OR.iqq.EQ.177.
631  & or.iqq.EQ.71.OR.iqq.EQ.73.OR.iqq.EQ.74.
632  & or.iqq.EQ.72.OR.iqq.EQ.75.OR.iqq.EQ.213.
633  & or.iqq.EQ.173.OR.iqq.EQ.174)) THEN
634  GO TO 300
635  END IF
636  DO jj = 1,is
637  IF (iss .EQ. hhh(jj)) GO TO 200
638  END DO
639  ierr = 5
640  RETURN
641 C
642  200 CONTINUE
643  IF (iss.EQ.4.OR.iss.EQ.5.OR.iss.EQ.20.OR.iss.EQ.100.OR.
644  & iss.EQ.103.OR.iss.EQ.105.OR.iss.EQ.107.OR.iss.EQ.109.OR.
645  & iss.EQ.111.OR.iss.EQ.113.OR.iss.EQ.115.OR.iss.EQ.117.OR.
646  & iss.EQ.119.OR.iss.EQ.125.OR.iss.EQ.126.OR.iss.EQ.160.OR.
647  & iss.EQ.236)THEN
648  titl(16:20) = hhhnam(jj)
649  level = mova2i(idpds(11:11)) * 256 + mova2i(idpds(12:12))
650  IF (iss.EQ.107.OR.iss.EQ.119) THEN
651  alevel = float(level) / 10000.0
652  WRITE (titl(9:15),fmt='(F6.4)') alevel
653  ELSE IF (iss.EQ.5) THEN
654 C DO NOTHING
655  ELSE
656  WRITE (titl(11:15),fmt='(I4)') level
657  END IF
658  ELSE IF (iss.EQ.1.OR.iss.EQ.6.OR.iss.EQ.7.OR.iss.EQ.8.OR.
659  & iss.EQ.9 .OR.iss.EQ.102.OR.iss.EQ.200.OR.iss.EQ.201.OR.
660  & iss.EQ.204.OR.iss.EQ.212.OR.iss.EQ.213.OR.iss.EQ.214.OR.
661  & iss.EQ.222.OR.iss.EQ.223.OR.iss.EQ.224.OR.iss.EQ.232.OR.
662  & iss.EQ.233.OR.iss.EQ.234.OR.iss.EQ.209.OR.iss.EQ.210.OR.
663  & iss.EQ.211.OR.iss.EQ.242.OR.iss.EQ.243.OR.iss.EQ.244.OR.
664  & iss.EQ.245.OR.iss.EQ.235.OR.iss.EQ.237.OR.iss.EQ.238.OR.
665  & iss.EQ.246.OR.iss.EQ.247.OR.iss.EQ.206.OR.iss.EQ.207.OR.
666  & iss.EQ.248.OR.iss.EQ.249.OR.iss.EQ.251.OR.iss.EQ.252) THEN
667  titl(16:20) = hhhnam(jj)
668  titl(1:4) = ' '
669  titl(11:15) = ' '
670  ELSE IF (iss.EQ.101.OR.iss.EQ.104.OR.iss.EQ.106.OR.iss.EQ.108.
671  & or.iss.EQ.110.OR.iss.EQ.112.OR.iss.EQ.114.OR.iss.EQ.116.OR.
672  & iss.EQ.120.OR.iss.EQ.121.OR.iss.EQ.128.OR.iss.EQ.141) THEN
673  titl(6:11) = hhhnam(jj)
674  titl(16:20) = hhhnam(jj)
675  itemp = mova2i(idpds(11:11))
676  WRITE (unit=titl(1:4),fmt='(I4)') itemp
677  jtemp = mova2i(idpds(12:12))
678  WRITE (unit=titl(11:15),fmt='(I4)') jtemp
679  END IF
680 C
681 C 5.0 INSERT THE YEAR,DAY,MONTH AND TIME
682 C
683  300 CONTINUE
684  ihr = mova2i(idpds(16:16))
685  iday = mova2i(idpds(15:15))
686  imon = mova2i(idpds(14:14))
687  iyr = mova2i(idpds(13:13))
688  icen = mova2i(idpds(25:25))
689 C
690 C SUBTRACT 1 FROM CENTURY TO MAKE 4 DIGIT YEAR
691 C
692  icen = icen - 1
693 C
694  iyr = icen * 100 + iyr
695  WRITE (unit=titl(59:62),fmt='(I4)') iyr
696  WRITE (unit=titl(52:53),fmt='(I2)') iday
697  WRITE (unit=titl(38:49),fmt='(A6,I2.2,A2)') 'AFTER ',ihr,'Z '
698  titl(55:57) = month(imon)
699  fcstim = mova2i(idpds(18:18))
700  titl(34:36) = timun(fcstim)
701  p1 = mova2i(idpds(19:19))
702  p2 = mova2i(idpds(20:20))
703  timerg = mova2i(idpds(21:21))
704  IF (timerg.EQ.10) THEN
705  p1 = p1 * 256 + p2
706  p2 = 0
707  END IF
708 C
709 C ADD CORRECTION IF BYTE 21 (TIME RANGE) IS 2
710 C
711  IF (timerg.EQ.2) THEN
712  titl(4:20) = titl(11:27)
713  titl(21:21) = ' '
714  WRITE (unit=titl(22:24),fmt='(I3)') p1
715  titl(25:28) = ' TO '
716  WRITE (unit=titl(29:32),fmt='(I3)') p2
717 C
718 C PRECIP AMOUNTS
719 C
720  ELSE IF (timerg.EQ.4) THEN
721  WRITE (unit=titl(29:32),fmt='(I3)') p2
722  mtemp = p2 - p1
723  WRITE (unit=titl(2:4),fmt='(I3)') mtemp
724  titl(6:7) = timun1(fcstim)
725  titl(8:12) = ' ACUM'
726 C
727 C AVERAGE
728 C
729  ELSE IF (timerg.EQ.3) THEN
730  WRITE (unit=titl(29:32),fmt='(I3)') p2
731  mtemp = p2 - p1
732  WRITE (unit=titl(2:4),fmt='(I3)') mtemp
733  titl(6:7) = timun1(fcstim)
734  titl(8:12) = ' AVG'
735 C
736 C CLIMATOLOGICAL MEAN VALUE
737 C
738  ELSE IF (timerg.EQ.51) THEN
739  WRITE (unit=titl(29:32),fmt='(I3)') p2
740  mtemp = p2 - p1
741  WRITE (unit=titl(2:4),fmt='(I3)') mtemp
742  titl(6:7) = timun1(fcstim)
743  titl(8:12) = ' AVG'
744  ELSE
745  WRITE (unit=titl(29:32),fmt='(I3)') p1
746  ENDIF
747 C
748 C TEST FOR ANALYSIS (MAKE CORRECTION IF MODEL IS ANALYSIS)
749 C
750  IF (timerg.EQ.0.AND.p1.EQ.0) THEN
751  titl(29:42) = ' ANALYSIS VT '
752  model = mova2i(idpds(6:6))
753  IF (model.EQ.10.OR.model.EQ.39.OR.model.EQ.45.OR.
754  & model.EQ.53.OR.model.EQ.68.OR.model.EQ.69.OR.
755  & model.EQ.70.OR.model.EQ.73.OR.model.EQ.74.OR.
756  & model.EQ.75.OR.model.EQ.76.OR.model.EQ.77.OR.
757  & model.EQ.78.OR.model.EQ.79.OR.model.EQ.80.OR.
758  & model.EQ.83.OR.model.EQ.84.OR.model.EQ.85.OR.
759  & model.EQ.86.OR.model.EQ.87.OR.model.EQ.88.OR.
760  & model.EQ.90.OR.model.EQ.91.OR.model.EQ.92.OR.
761  & model.EQ.105.OR.model.EQ.110.OR.model.EQ.150.OR.
762  & model.EQ.151) THEN
763  titl(29:42) = ' 00-HR FCST '
764  ENDIF
765  ENDIF
766 C
767 C TEST FOR 00-HR FCST (INITIALIZED ANALYSIS)
768 C
769  IF (timerg.EQ.1.AND.p1.EQ.0) THEN
770  titl(29:42) = ' 00-HR FCST '
771  ENDIF
772 C
773 C$ 3.0 FIND WHO GENERATED THE CODE
774 C$ CHECK FOR SUB-CENTERS
775 C
776  igenc = mova2i(idpds(5:5))
777  isubc = mova2i(idpds(26:26))
778 C
779 C TEST FOR SUB-CENTERS WHEN CENTER IS 7
780 C
781 
782  IF (isubc.NE.0.AND.igenc.EQ.7) THEN
783  DO j = 1,ics1
784  IF (isubc .EQ. scntr1(j)) THEN
785  titl(63:86) = knam2(j)
786  RETURN
787  END IF
788  END DO
789  ierr = 7
790  END IF
791 C
792 C TEST FOR SUB-CENTERS WHEN CENTER IS 9
793 C
794  IF (isubc.NE.0.AND.igenc.EQ.9) THEN
795  DO j = 1,ics2
796  IF (isubc .EQ. scntr2(j)) THEN
797  titl(63:86) = knam3(j)
798  RETURN
799  END IF
800  END DO
801  ierr = 8
802  END IF
803 C
804 C TEST TO SEE IF CENTER IN TABLES
805 C
806  DO i = 1,ic
807  IF (igenc .EQ. center(i)) THEN
808  titl(63:86) = knam1(i)
809  RETURN
810  END IF
811  END DO
812 C
813  ierr = 6
814  RETURN
815  END
mova2i
integer function mova2i(a)
This Function copies a bit string from a Character*1 variable to an integer variable.
Definition: mova2i.f:25
w3fp11
subroutine w3fp11(IPDS0, IPDS, TITL, IERR)
Converts GRIB formatted product definition section version 1 to a one line readable title.
Definition: w3fp11.f:79