NCEPLIBS-w3emc  2.11.0
w3fi70.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Computes scaling constants used by grdprt().
3 C> @author Ralph Jones @date 1991-10-26
4 C
5 C> Computes the four scaling constants used by grdprt, w3fp03,
6 C> or w3fp05 from the 28 byte (pds) product definition section of
7 C> grib edition one.
8 C>
9 C> Program history log:
10 C> - Ralph Jones 1991-10-26
11 C> - Ralph Jones 1993-03-29 Add save statement
12 C> - Ralph Jones 1993-08-08 Add 156 (cin), 158 (tke) to tables
13 C> - Ralph Jones 1993-10-16 Changes for o.n. 388 ver. oct. 8,1993
14 C>
15 C> @param[in] PDS 28 byte (pds) grib product definition section.
16 C> @param[out] CNST 4 constant's used by grdprt(), w3fp05(), or w3fp03().
17 C> @param[out] IER 0 = normal return | 1 = .
18 C>
19 C> @author Ralph Jones @date 1991-10-26
20  SUBROUTINE w3fi70(PDS,CNST,IER)
21 C
22 C SET DEFAULT VALUES FOR NMC FIELDS GRID PRINTING
23 C
24  REAL CNST(4)
25 C
26  INTEGER ID(25)
27  INTEGER Q
28 C
29  CHARACTER * 1 PDS(28)
30 C
31  SAVE
32 C
33 C UNPACK 28 BYTE (PDS) INTO 25 INTEGER WORDS
34 C
35  CALL w3fi69(pds,id)
36 C
37  ier = 0
38 C
39 C INDICATOR OF PARAMETER AND UNITS
40 C
41  q = id(8)
42 C
43 C INDICATOR OF LEVEL OR LAYERS
44 C
45  itypes = id(9)
46  i9 = id(9)
47 C
48 C HEIGHTS, PRESSURE, ETC. OF THE LEVEL OR LAYER
49 C
50  IF ((i9.GE.1.AND.i9.LE.100).OR.i9.EQ.102.OR.
51  & i9.EQ.103.OR.i9.EQ.105.OR.i9.EQ.107.OR.
52  & i9.EQ.109.OR.i9.EQ.111.OR.i9.EQ.113.OR.
53  & i9.EQ.125.OR.i9.EQ.160.OR.i9.EQ.200.OR.
54  & i9.EQ.201) THEN
55  ilvl = id(11)
56  ELSE
57  ilvl = id(10)
58  END IF
59 
60  IF (q.EQ.1.OR.q.EQ.2.OR.q.EQ.26) THEN
61 C
62 C*** PRESSURE, PRESSURE REDUCED TO MSL, PRESSURE ANOMALY (Pa)
63 C
64  cnst(1) = 0.0
65  cnst(2) = 0.01
66  cnst(3) = 4.0
67  cnst(4) = 0.0
68 C*** IF SFC, TROPOPAUSE PRESSURE, SIGMA ..
69  IF (itypes.EQ.1.OR.itypes.EQ.6.OR.itypes.EQ.7)cnst(3)=25.0
70  IF (itypes.EQ.107) cnst(3) = 25.0
71 C
72  ELSE IF (q.EQ.3) THEN
73 C
74 C*** PRESSURE TENDENCY (Pa/s)
75 C
76  cnst(1) = 0.0
77  cnst(2) = 1.0
78  cnst(3) = 4.0
79  cnst(4) = 0.0
80 C
81  ELSE IF (q.EQ.6) THEN
82 C
83 C*** GEOPOTENTIAL (m**2/s**2)
84 C
85  cnst(1) = 0.0
86  cnst(2) = 1.0
87  cnst(3) = 4.0
88  cnst(4) = 0.0
89 C
90  ELSE IF (q.EQ.7.OR.q.EQ.8.OR.q.EQ.27.OR.q.EQ.222) THEN
91 C
92 C*** GEOPOTENTIAL, GEOPOTENTIAL HEIGHT, ANOMALY
93 C*** 5-WAVE GEOPOTENTIAL HEIGHT ............
94 C
95  cnst(3) = 60.
96  IF (ilvl.LT.500) cnst(3) = 120.
97 C*** IF SFC OR TROPOPAUSE PRESSURE ..
98  IF ((itypes.EQ.1) .OR. (itypes.EQ.7)) cnst(3) = 500.0
99  IF (itypes.EQ.107) cnst(3) = 500.0
100 
101  cnst(1) = 0.0
102  cnst(2) = 1.0
103  cnst(4) = 0.0
104  IF (cnst(3) .EQ. 500.) cnst(4) = 2.0
105 C
106  ELSE IF (q.EQ.11.OR.q.EQ.12.OR.q.EQ.13.OR.q.EQ.14.OR.
107  & q.EQ.15.OR.q.EQ.16.OR.q.EQ.17.OR.q.EQ.18.OR.
108  & q.EQ.25.OR.q.EQ.85) THEN
109 C
110 
111 C*** TEMPERATURES (deg. K)
112 C*** VIRTUAL TEMPERATURE (deg. K)
113 C*** POTENTIAL TEMPERATURE (deg. K)
114 C*** PSEUDO-ADIABATIC POTENTIAL TEMPERATURE (deg. K)
115 C*** MAXIMUN TEMPERATURE (deg. K)
116 C*** MINUMUN TEMPERATURE (deg. K)
117 C*** DEW POINT TEMPERATURE (deg. K)
118 C*** DEW POINT DEPRESSION (OR DEFICIT) (deg. K)
119 C
120 C*** TEMP (DEG K) CONVERT TO DEG C, EXCEPT POTENTIAL TEMPERATURE
121 C
122 C CNST(1) = -273.15
123  cnst(1) = 0.0
124  cnst(2) = 1.0
125  cnst(3) = 5.0
126  cnst(4) = 0.0
127  IF (q.EQ.13) cnst(1) = 0.0
128 C
129  ELSE IF (q.EQ.19) THEN
130 C
131 C*** LAPSE RATE, deg. K/m ...............
132 C
133  cnst(1) = 0.0
134  cnst(2) = 1.0
135  cnst(3) = 4.0
136  cnst(4) = 0.0
137 C
138  ELSE IF (q.EQ.21.OR.q.EQ.22.OR.q.EQ.23) THEN
139 C
140 C*** RADAR SPECTRA (1), (2), (3) ...............
141 C
142  cnst(1) = 0.0
143  cnst(2) = 1.0
144  cnst(3) = 10.0
145  cnst(4) = 0.0
146 C
147  ELSE IF (q.EQ.28.OR.q.EQ.29.OR.q.EQ.30) THEN
148 C
149 C*** WAVE SPECTRA (1), (2), (3) ...............
150 C
151  cnst(1) = 0.0
152  cnst(2) = 1.0
153  cnst(3) = 10.0
154  cnst(4) = 0.0
155 C
156  ELSE IF (q.EQ.31) THEN
157 C
158 C*** WIND DIRECTION (deg. true)
159 C
160  cnst(1) = 0.0
161  cnst(2) = 1.0
162  cnst(3) = 10.0
163  cnst(4) = 0.0
164 C
165  ELSE IF (q.EQ.32.OR.q.EQ.33.OR.q.EQ.34) THEN
166 C
167 C*** WIND SPEED, U-COMPONENT OF WIND,
168 C*** V-COMPONENT OF WIND m/s -------------------
169 C
170  cnst(1) = 0.0
171  cnst(2) = 1.0
172  cnst(3) = 10.0
173  IF (itypes.EQ.1.AND.ilvl.EQ.0) cnst(3) = 3.0
174  IF (itypes.EQ.107) cnst(3) = 3.0
175  cnst(4) = 0.0
176 C
177  ELSE IF (q.EQ.35.OR.q.EQ.36) THEN
178 C
179 C*** STREAM FUNCTION, VELOCITY POTENTIAL (m**2/s)
180 C*** STREAM FUNCTION OR VELOCITY POTENTIAL (m**2/s) CONVERTED TO M.
181 C*** CONVERT TO METERS. (M*M/SEC * FOG)
182 C
183  cnst(1) = 0.
184  cnst(2) = 1.03125e-4 / 9.8
185  cnst(3) = 60.
186  cnst(4) = 0.
187 C
188  ELSE IF (q.EQ.37) THEN
189 C
190 C*** MONTGOMERY STREAM FUNCTION (m**2/s**2)
191 C
192  cnst(1) = 0.0
193  cnst(2) = 1.0
194  cnst(3) = 2.0
195  cnst(4) = 0.0
196 C
197  ELSE IF (q.EQ.38) THEN
198 C
199 C*** SIGMA COORD. VERTICAL VELOCITY (/s) TO MICROBARS/SEC
200 C
201  cnst(1) = 0.0
202  cnst(2) = 1.0
203  cnst(3) = 2.0
204  cnst(4) = 0.0
205 C
206  ELSE IF (q.EQ.39) THEN
207 C
208 C*** VERTICAL VELOCITY (Pa/s) TO MICROBARS/SEC
209 C*** SIGN CHANGED SUCH THAT POSITIVE VALUES INDICATE UPWARD MOTION.
210 C
211  cnst(1) = 0.0
212  cnst(2) = -1.e1
213  cnst(3) = 2.0
214  cnst(4) = 0.0
215 C
216  ELSE IF (q.EQ.40) THEN
217 C
218 C*** GEOMETRIC VERTICAL VELOCITY -DZDT- (m/s)
219 C
220  cnst(1) = 0.0
221  cnst(2) = 1.0
222  cnst(3) = 10.0
223  cnst(4) = 0.0
224 C
225  ELSE IF (q.EQ.41.OR.q.EQ.42.OR.q.EQ.43.OR.q.EQ.44.OR.
226  & q.EQ.45.OR.q.EQ.46) THEN
227 C
228 C*** ABSOLUTE VORTICITY -ABS-V (/s)
229 C*** ABSOLUTE DIVERGENCE -ABS-V (/s)
230 C*** RELATIVE VORTICITY -REL-V (/s)
231 C*** RELATIVE DIVERGENCE -REL-D (/s)
232 C*** VERTICAL U-COMPONENT SHEAR -VUCSH (/s)
233 C*** VERTICAL V-COMPONENT SHEAR -VVCSH (/s)
234 C
235  cnst(1) = 0.0
236  cnst(2) = 1.0e+6
237  cnst(3) = 40.0
238  cnst(4) = 0.0
239 C
240  ELSE IF (q.EQ.47) THEN
241 C
242 C*** DIRECTION OF CURRENT -DIR-C (deg. true)
243 C
244  cnst(1) = 0.0
245  cnst(2) = 1.0
246  cnst(3) = 10.0
247  cnst(4) = 0.0
248 C
249  ELSE IF (q.EQ.48.OR.q.EQ.49.OR.q.EQ.50) THEN
250 C
251 C*** SPEED OF CURRENT (m/s)
252 C*** U AND V COMPONENTS OF CURRENT (m/s)
253 C
254  cnst(1) = 0.
255  cnst(2) = 1.
256  cnst(3) = 2.
257  cnst(4) = 0.
258 C
259  ELSE IF (q.EQ.51.OR.q.EQ.53) THEN
260 C
261 C*** SPECIFIC HUMIDITY SPF H (kg/kg)
262 C*** HUMIDITY MIXING RATIO MIXR (kg/kg)
263 C
264  cnst(1) = 0.0
265  cnst(2) = 1.e+3
266  cnst(3) = 2.0
267  cnst(4) = 0.0
268 C
269  ELSE IF (q.EQ.52) THEN
270 C
271 C*** RELATIVE HUMIDITY R H (%)
272 C
273  cnst(1) = 0.0
274  cnst(2) = 1.0
275  cnst(3) = 20.0
276  cnst(4) = 0.0
277 C
278  ELSE IF (q.EQ.54.OR.q.EQ.57.OR.q.EQ.58) THEN
279 C
280 C*** PRECIPITABLE WATER (kg/m**2) OR .1 GRAM/CM*CM OR MILLIMETERS/CM*CM
281 C*** CHANGE TO CENTI-INCHES/CM*CM
282 C*** EVAPERATION
283 C*** CLOUD ICE (kg/m**2)
284 C
285  cnst(1) = 0.0
286  cnst(2) = 3.937
287  cnst(3) = 10.0
288  cnst(4) = 0.0
289 C
290  ELSE IF (q.EQ.55.OR.q.EQ.56) THEN
291 C
292 C*** VAPOR PRESSURE VAPP, SATURATION DEFICIT SAT D (Pa)
293 C
294  cnst(1) = 0.0
295  cnst(2) = 1.0
296  cnst(3) = 10.0
297  cnst(4) = 0.0
298 C
299  ELSE IF (q.EQ.59) THEN
300 C
301 C*** PRECIPITATION RATE (kg/m**2/s)
302 C
303  cnst(1) = 0.0
304  cnst(2) = 1.0
305  cnst(3) = 20.0
306  cnst(4) = 0.0
307 C
308  ELSE IF (q.EQ.60) THEN
309 C
310 C*** THUNDERSTORM PROBABILITY (%)
311 C
312  cnst(1) = 0.0
313  cnst(2) = 1.0
314  cnst(3) = 20.0
315  cnst(4) = 0.0
316 C
317  ELSE IF (q.EQ.61.OR.q.EQ.62.OR.q.EQ.63.OR.q.EQ.64.OR.
318  & q.EQ.65) THEN
319 C
320 C*** TOTAL PRECIPITATION A PCP (kg/m**2)
321 C*** LARGE SCALE PRECIPITATION NCPCP (kg/m**2)
322 C*** CONVECTIVE PRECIPITATION ACPCP (kg/m**2)
323 C*** SNOWFALL RATE WATER EQUIVALENT SRWEQ (kg/m**2/s)
324 C*** WATER EQUIV. OF ACCUM. SNOW DEPTH WEASD (kg/m**2)
325 C
326  cnst(1) = 0.0
327  cnst(2) = 1.0
328  cnst(3) = 2.0
329  cnst(4) = 0.0
330 
331  ELSE IF (q.EQ.66) THEN
332 C
333 C*** SNOW DEPTH (METERS) (1 or 0) for snow or no snow
334 C
335  cnst(1) = 0.0
336  cnst(2) = 1.0
337  cnst(3) = 1.0
338  cnst(4) = 0.0
339 C
340  ELSE IF (q.EQ.67.OR.q.EQ.68.OR.q.EQ.69.OR.q.EQ.70) THEN
341 C
342 C*** MIXING LAYER DEPTH MIXHT (m)
343 C*** TRANSIENT THEMOCLINE DEPTH TTHDP (m)
344 C*** MAIN THERMOCLINE DEPTH MTHCD (m)
345 C*** MAIN THERMOCLINE ANOMALY MTHCA (m)
346 C
347  cnst(1) = 0.0
348  cnst(2) = 39.37
349  cnst(3) = 06.0
350  cnst(4) = 0.0
351 C
352  ELSE IF (q.EQ.120.OR.q.EQ.121) THEN
353 C
354 C*** WAVE COMPONENT OF GEOPOTENTIAL (GEOP M)
355 C
356  cnst(1) = 0.0
357  cnst(2) = 1.0
358  cnst(3) = 10.0
359  cnst(4) = 0.0
360 C
361  ELSE IF (q.EQ.71.OR.q.EQ.72.OR.q.EQ.73.OR.q.EQ.74.OR.
362  & q.EQ.75) THEN
363 C
364 C*** TOTAL CLOUD COVER T CDC (%)
365 C*** CONVECTIVE CLOUD COVER CDCON (%)
366 C*** LOW CLOUD COVER L CDC (%)
367 C*** MEDIUM CLOUD COVER M CDC (%)
368 C*** HIGH CLOUD COVER H CDC (%)
369 C
370  cnst(1) = 0.0
371  cnst(2) = 1.0
372  cnst(3) = 10.0
373  cnst(4) = 0.0
374 C
375  ELSE IF (q.EQ.76) THEN
376 C
377 C*** CLOUD WATER -C-WAT (kg/m**2)
378 C
379  cnst(1) = 0.0
380  cnst(2) = 1.0
381  cnst(3) = 10.0
382  cnst(4) = 0.0
383 C
384  ELSE IF (q.EQ.78) THEN
385 C
386 C*** CONVECTIVE SNOW -C-SNO (kg/m**2)
387 C
388  cnst(1) = 0.0
389  cnst(2) = 1.0
390  cnst(3) = 10.0
391  cnst(4) = 0.0
392 C
393  ELSE IF (q.EQ.79) THEN
394 C
395 C*** LARGE SCALE SNOW -LSSNO (kg/m**2)
396 C
397  cnst(1) = 0.0
398  cnst(2) = 0.1
399  cnst(3) = 500.0
400  cnst(4) = 0.0
401 C
402  ELSE IF (q.EQ.80) THEN
403 C
404 C*** WATER TEMPERAUTER -WTMP- (deg. K)
405 C
406  cnst(1) = 0.0
407  cnst(2) = 1.0
408  cnst(3) = 2.0
409  cnst(4) = 0.0
410 C
411  ELSE IF (q.EQ.81) THEN
412 C
413 C*** LAND/SEA (1=LAND; 0=SEA)
414 C*** ICE CONCENTRATION (ICE=1; NO ICE=0)
415 C
416  cnst(1) = 0.0
417  cnst(2) = 1.0
418  cnst(3) = 1.0
419  cnst(4) = 0.5
420 C
421  ELSE IF (q.EQ.82.OR.q.EQ.83.OR.q.EQ.92.OR.q.EQ.97) THEN
422 C
423 C*** DEVIATION OF SEA LEVEL FROM MEAN (m)
424 C*** SUFACE ROUGHNESS (m)
425 C*** ICE THICKNESS (m)
426 C*** ICE GROWTH (m)
427 C
428  cnst(1) = 0.0
429  cnst(2) = 1.0
430  cnst(3) = 2.0
431  cnst(4) = 0.0
432 C
433  ELSE IF (q.EQ.84) THEN
434 C
435 C*** ALBEDO (%)
436 C
437  cnst(1) = 0.0
438  cnst(2) = 1.0
439  cnst(3) = 10.0
440  cnst(4) = 0.0
441 C
442  ELSE IF (q.EQ.86) THEN
443 C
444 C*** SOIL MOISTURE CONTENT (kg/m**2) -SOILM
445 C
446  cnst(1) = 0.0
447  cnst(2) = 1.0
448  cnst(3) = 10.0
449  cnst(4) = 0.0
450 C
451  ELSE IF (q.EQ.87) THEN
452 C
453 C*** VEGETATION -VEG- (%)
454 C
455  cnst(1) = 0.0
456  cnst(2) = 1.0
457  cnst(3) = 10.0
458  cnst(4) = 0.0
459 C
460  ELSE IF (q.EQ.88) THEN
461 C
462 C*** SALINITY -SALTY- (kg/kg)
463 C
464  cnst(1) = 0.0
465  cnst(2) = 1.0
466  cnst(3) = 10.0
467  cnst(4) = 0.0
468 C
469  ELSE IF (q.EQ.89) THEN
470 C
471 C*** DENSITY -DEN-- (kg/m**3)
472 C
473  cnst(1) = 0.0
474  cnst(2) = 1.0
475  cnst(3) = 10.0
476  cnst(4) = 0.0
477 C
478  ELSE IF (q.EQ.90) THEN
479 C
480 C*** WATER RUNOFF -WAT-R (kg/m**2)
481 C
482  cnst(1) = 0.0
483  cnst(2) = 1.0
484  cnst(3) = 10.0
485  cnst(4) = 0.0
486 C
487  ELSE IF (q.EQ.93) THEN
488 C
489 C*** DIRECTION OF ICE DRIFT -DICED (deg. true)
490 C
491  cnst(1) = 0.0
492  cnst(2) = 1.0
493  cnst(3) = 10.0
494  cnst(4) = 0.0
495 C
496  ELSE IF (q.EQ.94.OR.q.EQ.95.OR.q.EQ.96) THEN
497 C
498 C*** SPEED OF ICE DRIFT -SICED (m/s)
499 C*** U-COMPONENT OF ICE DRIFT -U-ICE (m/s)
500 C*** V-COMPONENT OF ICE DRIFT -V-ICE (m/s)
501 C
502  cnst(1) = 0.0
503  cnst(2) = 1.0
504  cnst(3) = 2.0
505  cnst(4) = 0.0
506 C
507  ELSE IF (q.EQ.98) THEN
508 C
509 C*** ICE DIVERGENCE -ICE D (/s)
510 C
511  cnst(1) = 0.0
512  cnst(2) = 1.0
513  cnst(3) = 10.0
514  cnst(4) = 0.0
515 C
516  ELSE IF (q.EQ.99) THEN
517 C
518 C*** SNO MELT -SNO- M (kg/m**2)
519 C
520  cnst(1) = 0.0
521  cnst(2) = 1.0
522  cnst(3) = 10.0
523  cnst(4) = 0.0
524 C
525  ELSE IF (q.EQ.100.OR.q.EQ.102.OR.q.EQ.105) THEN
526 C
527 C*** HEIGHT OF WIND DRIVEN OCEAN WAVES, SEA SWELLS, OR COMBINATION
528 C*** (m)
529 C
530  cnst(1) = 0.0
531  cnst(2) = 1.0
532  cnst(3) = 1.0
533  cnst(4) = 0.0
534 C
535  ELSE IF (q.EQ.101.OR.q.EQ.104.OR.q.EQ.107.OR.q.EQ.109) THEN
536 C
537 C*** DIRECTION OF WIND WAVES, SWELLS WAVES, PRIMARY WAVE, SECONDARY
538 C*** WAVE (deg. true) --------------------
539 C
540  cnst(1) = 0.0
541  cnst(2) = 1.0
542  cnst(3) = 20.0
543  cnst(4) = 0.0
544 C
545  ELSE IF (q.EQ.103.OR.q.EQ.106.OR.q.EQ.108.OR.q.EQ.110) THEN
546 C
547 C*** MEAN PERIOD OF WIND WAVES, SWELLS WAVES, PRIMARY WAVE, SECONDARY
548 C*** WAVE (s) --------------------
549 C
550  cnst(1) = 0.0
551  cnst(2) = 1.0
552  cnst(3) = 2.0
553  cnst(4) = 0.0
554 C
555  ELSE IF (q.EQ.111.OR.q.EQ.112.OR.q.EQ.113.OR.q.EQ.114.OR.
556  & q.EQ.115.OR.q.EQ.116.OR.q.EQ.117.OR.q.EQ.121.OR.
557  & q.EQ.122.OR.q.EQ.123) THEN
558 C
559 C*** NET SHORTWAVE RADITION (SURFACE) -NSWRS w/m **2
560 C*** NET LONGWAVE RADITION (SURFACE) -SHTFL w/m**2
561 C*** NET SHORTWAVE RADITION (TOP OF ATOMS.) -NSWRT w/m**2
562 C*** NET LONGWAVE RADITION (TOP OF ATOMS.) -NLWRT w/m**2
563 C*** LONG WAVE RADITION -LWAVR w/m**2
564 C*** SHORT WAVE RADITION -SWAVE w/m**2
565 C*** GLOBAL RADITION -G-RAD w/m**2
566 C*** LATENT HEAT FLUX -LHTFL w/m**2
567 C*** SENSIBLE HEAT FLUX -SHTFL w/m**2
568 C*** BOUNDARY LAYER DISSIPATION -BLYDP w/m**2
569 C
570  cnst(1) = 0.0
571  cnst(2) = 1.0
572  cnst(3) = 5.0
573  IF (q.EQ.114) cnst(3) = 20.0
574  cnst(4) = 0.0
575 C
576  ELSE IF (q.EQ.127) THEN
577 C
578 C IMAGE DATA -IMG-D
579 C
580  cnst(1) = 0.0
581  cnst(2) = 1.0
582  cnst(3) = 10.0
583  cnst(4) = 0.0
584 C
585  ELSE IF (q.EQ.128) THEN
586 C
587 C Mean Sea Level Pressure -MSLSA (Pa)
588 C (Standard Atmosphere Reduction)
589 C
590  cnst(1) = 0.0
591  cnst(2) = 0.01
592  cnst(3) = 4.0
593  cnst(4) = 0.0
594 C
595  ELSE IF (q.EQ.129) THEN
596 C
597 C Mean Sea Level Pressure -MSLMA (Pa)
598 C (Maps System Reduction)
599 C
600  cnst(1) = 0.0
601  cnst(2) = 0.01
602  cnst(3) = 4.0
603  cnst(4) = 0.0
604 C
605  ELSE IF (q.EQ.130) THEN
606 C
607 C Mean Sea Level Pressure -MSLET (Pa)
608 C (ETA Model Reduction)
609 C
610  cnst(1) = 0.0
611  cnst(2) = 0.01
612  cnst(3) = 4.0
613  cnst(4) = 0.0
614 C
615  ELSE IF (q.EQ.131.OR.q.EQ.132.OR.q.EQ.133.OR.q.EQ.134) THEN
616 C
617 C*** SURFACE LIFTED INDEX ..(DEG K)
618 C*** BEST (4 LAYER) LIFTED INDEX ..(DEG K)
619 C*** K INDEX ..(DEG K) TO DEG C.
620 C*** SWEAT INDEX ..(DEG K) TO DEG C.
621 C
622  IF (q.EQ.131.OR.q.EQ.132) THEN
623  cnst(1) = 0.0
624  ELSE
625  cnst(1) = -273.15
626  END IF
627  cnst(2) = 1.0
628  cnst(3) = 4.0
629  cnst(4) = 0.0
630 C
631  ELSE IF (q.EQ.135) THEN
632 C
633 C*** HORIZONTIAL MOISTURE DIVERGENCE (KG/KG/S) -MCONV
634 C
635  cnst(1) = 0.0
636  cnst(2) = 1.e+8
637  cnst(3) = 10.0
638  cnst(4) = 0.0
639 C
640  ELSE IF (q.EQ.136) THEN
641 C
642 C*** VERTICAL SPEED SHEAR (1/SEC)... TO BE CONVERTED TO KNOTS/1000 FT
643 C
644  cnst(1) = 0.0
645  cnst(2) = 592.086
646  cnst(3) = 2.0
647  cnst(4) = 0.0
648 C
649  ELSE IF (q.EQ.137) THEN
650 C
651 C*** 3-hr pressure tendency (TSLSA) (Pa/s)
652 C
653  cnst(1) = 0.0
654  cnst(2) = 1000.0
655  cnst(3) = 10.0
656  cnst(4) = 0.0
657 C
658  ELSE IF (q.EQ.156) THEN
659 C
660 C*** CONVECTIVE INHIBITION -CIN-- (J/kg)
661 C
662  cnst(1) = 0.0
663  cnst(2) = 1.0
664  cnst(3) = 10.0
665  cnst(4) = 0.0
666 C
667  ELSE IF (q.EQ.157) THEN
668 C
669 C*** CONVECTIVE AVAILABLE POTENTIAL ENERGY -CAPE- (J/kg)
670 C
671  cnst(1) = 0.0
672  cnst(2) = 1.0
673  cnst(3) = 500.0
674  cnst(4) = 0.0
675 C
676  ELSE IF (q.EQ.158) THEN
677 C
678 C*** TURBULENT KINETIC ENERGY -TKE-- (J/kg)
679 C
680  cnst(1) = 0.0
681  cnst(2) = 1.0
682  cnst(3) = 100.0
683  cnst(4) = 0.0
684 C
685  ELSE IF (q.EQ.175) THEN
686 C
687 C*** MODEL LAYER NUMBER (FROM BOTTOM UP) -SGLYR (non-dim)
688 C
689  cnst(1) = 0.0
690  cnst(2) = 1.0
691  cnst(3) = 1.0
692  cnst(4) = 0.0
693 C
694  ELSE IF (q.EQ.176) THEN
695 C
696 C*** LATITUDE (-90 TO +90) -NLAT- (deg)
697 C
698  cnst(1) = 0.0
699  cnst(2) = 1.0
700  cnst(3) = 10.0
701  cnst(4) = 0.0
702 C
703  ELSE IF (q.EQ.177) THEN
704 C
705 C*** EAST LATITUDE (0-360) -ELON- (deg)
706 C
707  cnst(1) = 0.0
708  cnst(2) = 1.0
709  cnst(3) = 10.0
710  cnst(4) = 0.0
711 C
712  ELSE IF (q.EQ.201) THEN
713 C
714 C*** ICE-FREE WATER SURFACE -ICWAT (%)
715 C
716  cnst(1) = 0.0
717  cnst(2) = 1.0
718  cnst(3) = 10.0
719  cnst(4) = 0.0
720 C
721  ELSE IF (q.EQ.204) THEN
722 C
723 C*** DOWNWARD SHORT WAVE RAD. FLUX -DSWRF (W/m**2)
724 C
725  cnst(1) = 0.0
726  cnst(2) = 1.0
727  cnst(3) = 10.0
728  cnst(4) = 0.0
729 C
730  ELSE IF (q.EQ.205) THEN
731 C
732 C*** DOWNWARD LONG WAVE RAD. FLUX -DLWRF (W/m**2)
733 C
734  cnst(1) = 0.0
735  cnst(2) = 1.0
736  cnst(3) = 10.0
737  cnst(4) = 0.0
738 C
739  ELSE IF (q.EQ.207) THEN
740 C
741 C*** MOISTURE AVAILABILITY -MSTAV (%)
742 C
743  cnst(1) = 0.0
744  cnst(2) = 1.0
745  cnst(3) = 10.0
746  cnst(4) = 0.0
747 C
748  ELSE IF (q.EQ.208) THEN
749 C
750 C*** EXCHANGE COEFFICIENT -SFEXC (kg/m**3)(m/s)
751 C
752  cnst(1) = 0.0
753  cnst(2) = 1.0
754  cnst(3) = 10.0
755  cnst(4) = 0.0
756 CC
757  ELSE IF (q.EQ.209) THEN
758 C
759 C*** NO. OF MIXED LAYERS NEXT TO SURFACE -MIXLY (integer)
760 C
761  cnst(1) = 0.0
762  cnst(2) = 1.0
763  cnst(3) = 10.0
764  cnst(4) = 0.0
765 C
766  ELSE IF (q.EQ.211) THEN
767 C
768 C*** UPWARD SHORT WAVE RAD. FLUX -USWRF (W/m**2)
769 C
770  cnst(1) = 0.0
771  cnst(2) = 1.0
772  cnst(3) = 10.0
773  cnst(4) = 0.0
774 C
775  ELSE IF (q.EQ.212) THEN
776 C
777 C*** UPWARD LONG WAVE RAD. FLUX -ULWRF (W/m**2)
778 C
779  cnst(1) = 0.0
780  cnst(2) = 1.0
781  cnst(3) = 10.0
782  cnst(4) = 0.0
783 C
784  ELSE IF (q.EQ.213) THEN
785 C
786 C*** AMOUNT OF NON-CONVECTIVE CLOUD -CDLYR (%)
787 C
788  cnst(1) = 0.0
789  cnst(2) = 1.0
790  cnst(3) = 10.0
791  cnst(4) = 0.0
792 C
793  ELSE IF (q.EQ.216) THEN
794 C
795 C*** TEMPERATURE TENDENCY BY ALL RADIATION -TTRAD (Deg. K/s)
796 C
797  cnst(1) = 0.0
798  cnst(2) = 1.0
799  cnst(3) = 10.0
800  cnst(4) = 0.0
801 C
802  ELSE IF (q.EQ.218) THEN
803 C
804 C*** PRECIP. INDEX (0.0-1.00) -PREIX (note will look like %)
805 C
806  cnst(1) = 0.0
807  cnst(2) = 100.0
808  cnst(3) = 10.0
809  cnst(4) = 0.0
810 C
811  ELSE IF (q.EQ.220) THEN
812 C
813 C*** NATURAL LOG OF SURFACE PRESSURE -NLGSP ln(kPa)
814 C
815  cnst(1) = 0.0
816  cnst(2) = 1.0
817  cnst(3) = 10.0
818  cnst(4) = 0.0
819 C
820 C*** NONE OF THE ABOVE ....
821 C
822  ELSE
823 C
824 C SET DEFAULT VALUES
825 C
826  cnst(1) = 0.0
827  cnst(2) = 1.0
828  cnst(3) = 5.0
829  cnst(4) = 0.0
830  ier = 1
831  END IF
832 C
833  RETURN
834  END
w3fi69
subroutine w3fi69(PDS, ID)
Converts an edition 1 grib produce definition section (pds) to a 25, or 27 word integer array.
Definition: w3fi69.f:29
w3fi70
subroutine w3fi70(PDS, CNST, IER)
Computes the four scaling constants used by grdprt, w3fp03, or w3fp05 from the 28 byte (pds) product ...
Definition: w3fi70.f:21