source: trunk/MESOSCALE_DEV/SRC/ARWpost/src/module_diagnostics.f90 @ 777

Last change on this file since 777 was 207, checked in by aslmd, 14 years ago

MESOSCALE: A GENERAL CLEAN-UP FOLLOWING UPDATING THE USER MANUAL. EVERYTHING ESSENTIAL IS IN MESOSCALE (much lighter than before). EVERYTHING FOR DEVELOPPERS OR EXPERTS IS IN MESOSCALE_DEV.

File size: 20.6 KB
Line 
1!! Diagnostics
2!! See moddule_diagnostic for which fields are available
3
4MODULE module_diagnostics
5
6  USE output_module
7  USE gridinfo_module
8  USE module_interp
9  USE module_arrays
10  USE constants_module
11  USE module_pressure
12
13
14  USE module_calc_pressure
15  USE module_calc_height
16  USE module_calc_theta
17  USE module_calc_tk
18  USE module_calc_tc
19  USE module_calc_td
20  USE module_calc_rh
21  USE module_calc_uvmet
22  USE module_calc_wdir
23  USE module_calc_wspd
24  USE module_calc_slp
25  USE module_calc_dbz
26  USE module_calc_cape
27  USE module_calc_clfr
28
29  CONTAINS
30
31   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
32   ! Name: process_diagnostics
33   ! Purpose: All new calls to diagnostics routines go here
34   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
35   SUBROUTINE process_diagnostics ()
36
37      IMPLICIT NONE
38
39      ! Local variables
40      character (len=128)                    :: cname, cunits, cdesc, c_nm
41      real, allocatable, dimension(:,:)      :: SCR2
42      real, pointer, dimension(:,:,:)        :: SCR3
43      real, allocatable, dimension(:,:,:,:)  :: SCR4
44      real, pointer, dimension(:,:,:)        :: SCR
45      real, pointer, dimension(:,:,:)        :: data_out
46      integer                                :: nxout, nyout, nzout
47      integer                                :: ii, jj, kk
48
49
50
51!!! If we don't have PRES (Pa) already - calculate and keep
52      IF ( .not. have_PRES ) THEN
53        IF ( iprogram == 8 .AND. have_P .AND. have_PB ) THEN
54          ALLOCATE(SCR3(west_east_dim,south_north_dim,bottom_top_dim))
55          SCR3 = P + PB
56          c_nm = 'PRES'
57          CALL keep_arrays(c_nm, SCR3)
58        END IF
59        IF ( iprogram == 6 .AND. have_MU .AND. have_MUB .AND. have_ZNU .AND. have_ZNW .AND. have_PTOP) THEN
60          CALL pressure(SCR3)
61          c_nm = 'PRES'
62          CALL keep_arrays(c_nm, SCR3)
63        END IF
64        DEALLOCATE(SCR3)
65      END IF
66
67
68!!! If we don't have TK (K) already - calculate and keep
69      IF ( .not. have_TK ) THEN
70        IF ( have_T .AND. have_PRES ) THEN
71          ALLOCATE(SCR3(west_east_dim,south_north_dim,bottom_top_dim))
72          c_nm = 'TK'
73!!          SCR3 = (T+300.) * ( PRES / p0 )**RCP
74          SCR3 = (T+220.) * ( PRES / p0 )**RCP
75          CALL keep_arrays(c_nm, SCR3)
76          DEALLOCATE(SCR3)
77        END IF
78      END IF
79
80
81
82!!
83!! DIAGNOSTICS GO HERE
84!!
85
86
87
88!!! Calculate pressure in hPA
89        IF ( INDEX(plot_these_fields,",pressure,") /= 0 ) THEN
90          IF ( have_PRES ) THEN
91            IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
92            ALLOCATE(SCR(west_east_dim,south_north_dim,bottom_top_dim))
93            CALL calc_pressure(SCR, cname, cdesc, cunits)
94            CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
95                         data_out, nxout, nyout, nzout, &
96                         vert_array, interp_levels, number_of_zlevs)
97            CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
98            DEALLOCATE(SCR)
99          END IF
100        END IF
101
102
103!!! Calculate height from PH and PHB
104        IF ( INDEX(plot_these_fields,",height,") /= 0 ) THEN
105          IF ( have_PH .AND. have_PHB ) THEN
106            IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
107            ALLOCATE(SCR(west_east_dim,south_north_dim,bottom_top_dim))
108            CALL calc_height(SCR, cname, cdesc, cunits)
109            CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
110                         data_out, nxout, nyout, nzout, &
111                         vert_array, interp_levels, number_of_zlevs)
112            CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
113            DEALLOCATE(SCR)
114          END IF
115        END IF
116
117
118!!! Calculate temperature
119        IF ( INDEX(plot_these_fields,",tk,") /= 0 ) THEN
120          IF ( have_TK ) THEN
121            IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
122            ALLOCATE(SCR(west_east_dim,south_north_dim,bottom_top_dim))
123            CALL calc_tk(SCR, cname, cdesc, cunits)
124            CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
125                         data_out, nxout, nyout, nzout, &
126                         vert_array, interp_levels, number_of_zlevs)
127            CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
128            DEALLOCATE(SCR)
129          END IF
130        END IF
131        IF ( INDEX(plot_these_fields,",tc,") /= 0 ) THEN
132          IF ( have_TK ) THEN
133            IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
134            ALLOCATE(SCR(west_east_dim,south_north_dim,bottom_top_dim))
135            CALL calc_tc(SCR, cname, cdesc, cunits)
136            CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
137                         data_out, nxout, nyout, nzout, &
138                         vert_array, interp_levels, number_of_zlevs)
139            CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
140            DEALLOCATE(SCR)
141          END IF
142        END IF
143
144
145!!! Calculate theta
146        IF ( INDEX(plot_these_fields,",theta,") /= 0 ) THEN
147          IF ( have_T ) THEN
148            IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
149            ALLOCATE(SCR(west_east_dim,south_north_dim,bottom_top_dim))
150            CALL calc_theta(SCR, cname, cdesc, cunits)
151            CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
152                         data_out, nxout, nyout, nzout, &
153                         vert_array, interp_levels, number_of_zlevs)
154            CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
155            DEALLOCATE(SCR)
156          END IF
157        END IF
158
159
160!!! Dewpoint temperature
161        IF ( INDEX(plot_these_fields,",td,") /= 0 ) THEN
162          IF ( have_QV .AND. have_PRES ) THEN
163            IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
164            ALLOCATE(SCR(west_east_dim,south_north_dim,bottom_top_dim))
165            CALL calc_td(SCR, cname, cdesc, cunits)
166            CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
167                         data_out, nxout, nyout, nzout, &
168                         vert_array, interp_levels, number_of_zlevs)
169            CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
170            DEALLOCATE(SCR)
171          END IF
172        END IF
173
174
175!!! Relative Humidity   
176        IF ( INDEX(plot_these_fields,",rh,") /= 0 .OR. INDEX(plot_these_fields,",clfr,") /= 0 ) THEN
177          IF ( have_TK .AND. have_QV .AND. have_PRES ) THEN
178            IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
179            ALLOCATE(SCR(west_east_dim,south_north_dim,bottom_top_dim))
180            CALL calc_rh(SCR, cname, cdesc, cunits)
181            CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
182                         data_out, nxout, nyout, nzout, &
183                         vert_array, interp_levels, number_of_zlevs)
184            CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
185
186            !!!  Cloud fractions
187            IF ( INDEX(plot_these_fields,",clfr,") /= 0 ) THEN
188              IF ( ALLOCATED(SCR4) ) DEALLOCATE(SCR4)
189              ALLOCATE(SCR4(west_east_dim,south_north_dim,bottom_top_dim,4))
190              SCR4 = 0.0
191              CALL calc_clfr(SCR4, cname, cdesc, cunits, SCR)
192              DEALLOCATE(SCR)
193              ALLOCATE(SCR(west_east_dim,south_north_dim,1))
194              cname = "clflo"
195              cdesc = "Low Cloud Fraction"
196              SCR(:,:,1) = SCR4(:,:,1,1)
197              CALL interp (SCR, west_east_dim, south_north_dim, 1, &
198                           data_out, nxout, nyout, nzout, &
199                           vert_array, interp_levels, number_of_zlevs)
200              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
201              cname = "clfmi"
202              cdesc = "Mid Cloud Fraction"
203              SCR(:,:,1) = SCR4(:,:,1,2)
204              CALL interp (SCR, west_east_dim, south_north_dim, 1, &
205                           data_out, nxout, nyout, nzout, &
206                           vert_array, interp_levels, number_of_zlevs)
207              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
208              cname = "clfhi"
209              cdesc = "High Cloud Fraction"
210              SCR(:,:,1) = SCR4(:,:,1,3)
211              CALL interp (SCR, west_east_dim, south_north_dim, 1, &
212                           data_out, nxout, nyout, nzout, &
213                           vert_array, interp_levels, number_of_zlevs)
214              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
215            END IF
216
217            DEALLOCATE(SCR)
218          END IF
219        END IF
220
221
222!!! Wind speed       
223        IF ( INDEX(plot_these_fields,",wspd,") /= 0 ) THEN
224          IF ( have_UUU .AND. have_VVV ) THEN
225            IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
226            ALLOCATE(SCR(west_east_dim,south_north_dim,bottom_top_dim))
227            CALL calc_wspd(SCR, cname, cdesc, cunits, 1)
228            CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
229                         data_out, nxout, nyout, nzout, &
230                         vert_array, interp_levels, number_of_zlevs)
231            CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
232            DEALLOCATE(SCR)
233          END IF
234        END IF
235
236
237!!! Wind direction       
238        IF ( INDEX(plot_these_fields,",wdir,") /= 0 ) THEN
239          IF ( have_UUU .AND. have_VVV ) THEN
240            IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
241            ALLOCATE(SCR(west_east_dim,south_north_dim,bottom_top_dim))
242            CALL calc_wdir(SCR, cname, cdesc, cunits, 1)
243            CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
244                         data_out, nxout, nyout, nzout, &
245                         vert_array, interp_levels, number_of_zlevs)
246            CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
247            DEALLOCATE(SCR)
248          END IF
249        END IF
250
251
252!!! Wind speed  - 10m     
253        IF ( INDEX(plot_these_fields,",ws10,") /= 0 ) THEN
254          IF ( have_U10 .AND. have_V10 ) THEN
255            IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
256            ALLOCATE(SCR(west_east_dim,south_north_dim,1))
257            CALL calc_wspd(SCR, cname, cdesc, cunits, 0)
258            CALL interp (SCR, west_east_dim, south_north_dim, 1, &
259                         data_out, nxout, nyout, nzout, &
260                         vert_array, interp_levels, number_of_zlevs)
261            CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
262            DEALLOCATE(SCR)
263          END IF
264        END IF
265
266
267!!! Wind direction  - 10m     
268        IF ( INDEX(plot_these_fields,",wd10,") /= 0 ) THEN
269          IF ( have_U10 .AND. have_V10 ) THEN
270            IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
271            ALLOCATE(SCR(west_east_dim,south_north_dim,1))
272            CALL calc_wdir(SCR, cname, cdesc, cunits, 0)
273            CALL interp (SCR, west_east_dim, south_north_dim, 1, &
274                         data_out, nxout, nyout, nzout, &
275                         vert_array, interp_levels, number_of_zlevs)
276            CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
277            DEALLOCATE(SCR)
278          END IF
279        END IF
280
281
282!!! Rotated U and V     
283        IF ( INDEX(plot_these_fields,",umet,") /= 0 .OR. &
284             INDEX(plot_these_fields,",vmet,") /= 0) THEN
285          IF ( have_UUU .AND. have_VVV .AND. have_XLAT .AND. have_XLONG ) THEN
286
287            IF ( ALLOCATED(SCR4) ) DEALLOCATE(SCR4)
288            ALLOCATE(SCR4(west_east_dim,south_north_dim,bottom_top_dim,4))
289            SCR4 = 0.0
290            CALL calc_uvmet(SCR4, cname, cdesc, cunits)
291
292            ALLOCATE(SCR(west_east_dim,south_north_dim,bottom_top_dim))
293            IF ( INDEX(plot_these_fields,",umet,") /= 0 ) THEN
294              cname = "umet"
295              SCR(:,:,:) = SCR4(:,:,:,1)
296              CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
297                           data_out, nxout, nyout, nzout, &
298                           vert_array, interp_levels, number_of_zlevs)
299              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
300            END IF
301            IF ( INDEX(plot_these_fields,",vmet,") /= 0) THEN
302              cname = "vmet"
303              SCR(:,:,:) = SCR4(:,:,:,2)
304              CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
305                           data_out, nxout, nyout, nzout, &
306                           vert_array, interp_levels, number_of_zlevs)
307              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
308            END IF
309            DEALLOCATE(SCR)
310            DEALLOCATE(SCR4)
311
312          END IF
313        END IF
314
315
316!!! Rotated U10 and V10     
317        IF ( INDEX(plot_these_fields,",u10m,") /= 0 .OR. &
318             INDEX(plot_these_fields,",v10m,") /= 0) THEN
319          IF ( have_U10 .AND. have_V10 .AND. have_XLAT .AND. have_XLONG ) THEN
320
321            IF ( ALLOCATED(SCR4) ) DEALLOCATE(SCR4)
322            ALLOCATE(SCR4(west_east_dim,south_north_dim,bottom_top_dim,4))
323            SCR4 = 0.0
324            CALL calc_uvmet(SCR4, cname, cdesc, cunits)
325
326            ALLOCATE(SCR(west_east_dim,south_north_dim,1))
327            IF ( INDEX(plot_these_fields,",u10m,") /= 0 ) THEN
328              cname = "u10m"
329              SCR(:,:,1) = SCR4(:,:,1,1)
330              CALL interp (SCR, west_east_dim, south_north_dim, 1, &
331                           data_out, nxout, nyout, nzout, &
332                           vert_array, interp_levels, number_of_zlevs)
333              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
334            END IF
335            IF ( INDEX(plot_these_fields,",v10m,") /= 0) THEN
336              cname = "v10m"
337              SCR(:,:,1) = SCR4(:,:,1,2)
338              CALL interp( SCR, west_east_dim, south_north_dim, 1, &
339                           data_out, nxout, nyout, nzout, &
340                           vert_array, interp_levels, number_of_zlevs)
341              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
342            END IF
343            DEALLOCATE(SCR)
344            DEALLOCATE(SCR4)
345
346          END IF
347        END IF
348
349
350!!! Sea Level Pressure 
351        IF ( INDEX(plot_these_fields,",slp,") /= 0 ) THEN
352          IF ( have_TK .AND. have_QV .AND. have_PRES .AND. have_PH .AND. have_PHB) THEN
353            IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
354            ALLOCATE(SCR(west_east_dim,south_north_dim,bottom_top_dim))
355            CALL calc_slp(SCR, cname, cdesc, cunits)
356            CALL interp (SCR, west_east_dim, south_north_dim, 1, &
357                         data_out, nxout, nyout, nzout, &
358                         vert_array, interp_levels, number_of_zlevs)
359            CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
360            DEALLOCATE(SCR)
361          END IF
362        END IF
363
364
365!!! Reflectivity             
366        IF ( INDEX(plot_these_fields,",dbz,") /= 0 .OR. &
367             INDEX(plot_these_fields,",max_dbz,") /= 0) THEN
368          IF ( have_QV .AND. have_QR .AND. have_TK .AND. have_PRES ) THEN
369            CALL calc_dbz(SCR, cname, cdesc, cunits)
370
371            IF ( INDEX(plot_these_fields,",dbz,") /= 0 ) THEN
372              CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
373                           data_out, nxout, nyout, nzout, &
374                           vert_array, interp_levels, number_of_zlevs)
375              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
376            END IF
377
378            IF ( INDEX(plot_these_fields,",max_dbz,") /= 0) THEN
379              ALLOCATE(SCR2(west_east_dim,south_north_dim))
380              SCR2 = 0.0
381              DO jj = 1,south_north_dim
382                DO ii = 1,west_east_dim
383                  DO kk = 1,bottom_top_dim
384                    SCR2(ii,jj) = MAX( SCR2(ii,jj) , SCR(ii,jj,kk) )
385                  END DO
386                END DO
387              END DO
388              IF (ASSOCIATED(SCR)) DEALLOCATE(SCR)
389              ALLOCATE(SCR(west_east_dim,south_north_dim,1))
390              SCR(:,:,1) = SCR2(:,:)
391              cname = "max_dbz"
392              cdesc    = "Max Reflectivity"
393              CALL interp (SCR, west_east_dim, south_north_dim, 1, &
394                           data_out, nxout, nyout, nzout, &
395                           vert_array, interp_levels, number_of_zlevs)
396              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
397              DEALLOCATE(SCR2)
398              DEALLOCATE(SCR)
399            END IF
400
401          END IF
402        END IF
403
404
405
406!!! 3D CAPE/CIN
407        IF ( INDEX(plot_these_fields,",cape,") /= 0 .OR. &
408             INDEX(plot_these_fields,",cin,") /= 0) THEN
409          IF ( have_HGT .AND. have_QV .AND. have_PRES .AND. have_TK .AND. &
410               have_PH .AND. have_PHB) THEN
411
412            IF ( ALLOCATED(SCR4) ) DEALLOCATE(SCR4)
413            ALLOCATE(SCR4(west_east_dim,south_north_dim,bottom_top_dim,4))
414            SCR4 = 0.0
415            CALL calc_cape(SCR4, cname, cdesc, cunits,1)
416
417            ALLOCATE(SCR(west_east_dim,south_north_dim,bottom_top_dim))
418            IF ( INDEX(plot_these_fields,",cape,") /= 0 ) THEN
419              cname = "cape"
420              cdesc = "CAPE"
421              cunits = "J/kg"
422              SCR(:,:,:) = SCR4(:,:,:,1)
423              CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
424                           data_out, nxout, nyout, nzout, &
425                           vert_array, interp_levels, number_of_zlevs)
426              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
427            END IF
428            IF ( INDEX(plot_these_fields,",cin,") /= 0) THEN
429              cname = "cin"
430              cdesc = "CIN"
431              cunits = "J/kg"
432              SCR(:,:,:) = SCR4(:,:,:,2)
433              CALL interp (SCR, west_east_dim, south_north_dim, bottom_top_dim, &
434                           data_out, nxout, nyout, nzout, &
435                           vert_array, interp_levels, number_of_zlevs)
436              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
437            END IF
438            DEALLOCATE(SCR)
439            DEALLOCATE(SCR4)
440
441          END IF
442        END IF
443
444
445
446!!! 2D CAPE/CIN & LCL/LFC
447        IF ( INDEX(plot_these_fields,",mcape,") /= 0 .OR. &
448             INDEX(plot_these_fields,",mcin,") /= 0 .OR.  &
449             INDEX(plot_these_fields,",lcl,") /= 0 .OR.   &
450             INDEX(plot_these_fields,",lfc,") /= 0) THEN
451          IF ( have_HGT .AND. have_QV .AND. have_PRES .AND. have_TK .AND. &
452               have_PH .AND. have_PHB) THEN
453
454            IF ( ALLOCATED(SCR4) ) DEALLOCATE(SCR4)
455            ALLOCATE(SCR4(west_east_dim,south_north_dim,bottom_top_dim,4))
456            SCR4 = 0.0
457            CALL calc_cape(SCR4, cname, cdesc, cunits,0)
458
459            ALLOCATE(SCR(west_east_dim,south_north_dim,1))
460            IF ( INDEX(plot_these_fields,",mcape,") /= 0 ) THEN
461              cname = "mcape"
462              cdesc = "MCAPE"
463              cunits = "J/kg"
464              SCR(:,:,1) = SCR4(:,:,1,1)
465              CALL interp (SCR, west_east_dim, south_north_dim, 1, &
466                           data_out, nxout, nyout, nzout, &
467                           vert_array, interp_levels, number_of_zlevs)
468              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
469            END IF
470            IF ( INDEX(plot_these_fields,",mcin,") /= 0) THEN
471              cname = "mcin"
472              cdesc = "MCIN"
473              cunits = "J/kg"
474              SCR(:,:,1) = SCR4(:,:,1,2)
475              CALL interp (SCR, west_east_dim, south_north_dim, 1, &
476                           data_out, nxout, nyout, nzout, &
477                           vert_array, interp_levels, number_of_zlevs)
478              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
479            END IF
480            IF ( INDEX(plot_these_fields,",lcl,") /= 0) THEN
481              cname = "lcl"
482              cdesc = "LCL"
483              cunits = "meters AGL"
484              SCR(:,:,1) = SCR4(:,:,1,3)
485              CALL interp (SCR, west_east_dim, south_north_dim, 1, &
486                           data_out, nxout, nyout, nzout, &
487                           vert_array, interp_levels, number_of_zlevs)
488              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
489            END IF
490            IF ( INDEX(plot_these_fields,",lfc,") /= 0) THEN
491              cname = "lfc"
492              cdesc = "LFC"
493              cunits = "meters AGL"
494              SCR(:,:,1) = SCR4(:,:,1,4)
495              CALL interp (SCR, west_east_dim, south_north_dim, 1, &
496                           data_out, nxout, nyout, nzout, &
497                           vert_array, interp_levels, number_of_zlevs)
498              CALL write_dat (data_out, nxout, nyout, nzout, cname, cdesc, cunits)
499            END IF
500            DEALLOCATE(SCR)
501            DEALLOCATE(SCR4)
502
503          END IF
504        END IF
505
506
507       IF ( ALLOCATED(SCR4) ) DEALLOCATE(SCR4)
508       IF ( ASSOCIATED(SCR) ) DEALLOCATE(SCR)
509
510   END SUBROUTINE process_diagnostics
511
512END MODULE module_diagnostics
Note: See TracBrowser for help on using the repository browser.