Home

Context Navigation

source: palm/trunk/SOURCE/sum_up_3d_data.f90 @ 3909

Last change on this file since 3909 was 3773, checked in by maronga, 6 years ago
added output of theta_2m_av and minor revisions in palm_csd
Property svn:keywords set to `Id`
File size: 45.6 KB

Line
1	!> @file sum_up_3d_data.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2019 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! ------------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: sum_up_3d_data.f90 3773 2019-03-01 08:56:57Z suehring $
27	! Added output of theta_2m*_xy_av
28	!
29	! 3761 2019-02-25 15:31:42Z raasch
30	! unused variables removed
31	!
32	! 3655 2019-01-07 16:51:22Z knoop
33	! Implementation of the PALM module interface
34	!
35	! 3597 2018-12-04 08:40:18Z maronga
36	! Added output of theta_2m
37	!
38	! 3589 2018-11-30 15:09:51Z suehring
39	! Move the control parameter "salsa" from salsa_mod to control_parameters
40	! (M. Kurppa)
41	!
42	! 3582 2018-11-29 19:16:36Z suehring
43	! dom_dwd_user, Schrempf:
44	! Remove CALLs to uv exposure model, this is now part of biometeorology_mod
45	!
46	! 3553 2018-11-22 10:30:48Z suehring
47	! variables documented
48	!
49	! 3552 2018-11-22 10:28:35Z suehring
50	! Changes related to clean-up of biometeorology (dom_dwd_user)
51	!
52	! 3467 2018-10-30 19:05:21Z suehring
53	! Implementation of a new aerosol module salsa.
54	!
55	! 3448 2018-10-29 18:14:31Z kanani
56	! Adjustment of biometeorology calls
57	!
58	! 3421 2018-10-24 18:39:32Z gronemeier
59	! Renamed output variables
60	!
61	! 3337 2018-10-12 15:17:09Z kanani
62	! (from branch resler)
63	! Add biometeorology,
64	! fix chemistry output call,
65	! move usm calls
66	!
67	! 3294 2018-10-01 02:37:10Z raasch
68	! changes concerning modularization of ocean option
69	!
70	! 3291 2018-09-28 11:33:03Z scharf
71	! corrected previous commit for 3D topography
72	!
73	! 3285 2018-09-27 17:16:52Z scharf
74	! bugfix for shf_av and qsws_av
75	!
76	! 3274 2018-09-24 15:42:55Z knoop
77	! Modularization of all bulk cloud physics code components
78	!
79	! 3241 2018-09-12 15:02:00Z raasch
80	! unused variables removed
81	!
82	! 3176 2018-07-26 17:12:48Z suehring
83	! Remove output of latent heat flux at urban-surfaces and set fill values
84	! instead
85	!
86	! 3173 2018-07-26 12:55:23Z suehring
87	! Bugfix for last commit
88	!
89	! 3170 2018-07-25 15:19:37Z suehring
90	! Revise output of surface quantities in case of overhanging structures
91	!
92	! 3151 2018-07-19 08:45:38Z raasch
93	! Remaining preprocessor directive __chem removed
94	!
95	! 3004 2018-04-27 12:33:25Z Giersch
96	! prr field added to ONLY-list, prr* case/pr* case/precipitation_rate_av
97	! removed, further allocation checks implemented
98	!
99	! 2963 2018-04-12 14:47:44Z suehring
100	! Introduce index for vegetation/wall, pavement/green-wall and water/window
101	! surfaces, for clearer access of surface fraction, albedo, emissivity, etc. .
102	!
103	! 2894 2018-03-15 09:17:58Z Giersch
104	! Changed comment
105	!
106	! 2817 2018-02-19 16:32:21Z suehring
107	! Preliminary gust module interface implemented
108	!
109	! 2798 2018-02-09 17:16:39Z suehring
110	! Consider also default-type surfaces for surface temperature output.
111	!
112	! 2797 2018-02-08 13:24:35Z suehring
113	! Enable output of ground-heat flux also at urban surfaces.
114	!
115	! 2790 2018-02-06 11:57:19Z suehring
116	! Bugfix in summation of surface sensible and latent heat flux
117	!
118	! 2766 2018-01-22 17:17:47Z kanani
119	! Removed preprocessor directive __chem
120	!
121	! 2743 2018-01-12 16:03:39Z suehring
122	! In case of natural- and urban-type surfaces output surfaces fluxes in W/m2.
123	!
124	! 2742 2018-01-12 14:59:47Z suehring
125	! Enable output of surface temperature
126	!
127	! 2735 2018-01-11 12:01:27Z suehring
128	! output of r_a moved from land-surface to consider also urban-type surfaces
129	!
130	! 2718 2018-01-02 08:49:38Z maronga
131	! Corrected "Former revisions" section
132	!
133	! 2696 2017-12-14 17:12:51Z kanani
134	! - Change in file header (GPL part)
135	! - Implementation of uv exposure model (FK)
136	! - output of diss_av, kh_av, km_av (turbulence_closure_mod) (TG)
137	! - Implementation of chemistry module (FK)
138	! - Workaround for sum-up usm arrays in case of restart runs, to avoid program
139	! crash (MS)
140	!
141	! 2292 2017-06-20 09:51:42Z schwenkel
142	! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
143	! includes two more prognostic equations for cloud drop concentration (nc)
144	! and cloud water content (qc).
145	!
146	! 2233 2017-05-30 18:08:54Z suehring
147	!
148	! 2232 2017-05-30 17:47:52Z suehring
149	! Adjustments to new surface concept
150	!
151	! 2031 2016-10-21 15:11:58Z knoop
152	! renamed variable rho to rho_ocean and rho_av to rho_ocean_av
153	!
154	! 2024 2016-10-12 16:42:37Z kanani
155	! Added missing CASE for ssws*
156	!
157	! 2011 2016-09-19 17:29:57Z kanani
158	! Flag urban_surface is now defined in module control_parameters,
159	! changed prefix for urban surface model output to "usm_",
160	! introduced control parameter varnamelength for LEN of trimvar.
161	!
162	! 2007 2016-08-24 15:47:17Z kanani
163	! Added support for new urban surface model (temporary modifications of
164	! SELECT CASE ( ) necessary, see variable trimvar),
165	! added comments in variable declaration section
166	!
167	! 2000 2016-08-20 18:09:15Z knoop
168	! Forced header and separation lines into 80 columns
169	!
170	! 1992 2016-08-12 15:14:59Z suehring
171	! Bugfix in summation of passive scalar
172	!
173	! 1976 2016-07-27 13:28:04Z maronga
174	! Radiation actions are now done directly in the respective module
175	!
176	! 1972 2016-07-26 07:52:02Z maronga
177	! Land surface actions are now done directly in the respective module
178	!
179	! 1960 2016-07-12 16:34:24Z suehring
180	! Scalar surface flux added
181	!
182	! 1949 2016-06-17 07:19:16Z maronga
183	! Bugfix: calculation of lai_av, c_veg_av and c_liq_av.
184	!
185	! 1849 2016-04-08 11:33:18Z hoffmann
186	! precipitation_rate moved to arrays_3d
187	!
188	! 1788 2016-03-10 11:01:04Z maronga
189	! Added z0q and z0q_av
190	!
191	! 1693 2015-10-27 08:35:45Z maronga
192	! Last revision text corrected
193	!
194	! 1691 2015-10-26 16:17:44Z maronga
195	! Added output of Obukhov length and radiative heating rates for RRTMG.
196	! Corrected output of liquid water path.
197	!
198	! 1682 2015-10-07 23:56:08Z knoop
199	! Code annotations made doxygen readable
200	!
201	! 1585 2015-04-30 07:05:52Z maronga
202	! Adapted for RRTMG
203	!
204	! 1555 2015-03-04 17:44:27Z maronga
205	! Added output of r_a and r_s
206	!
207	! 1551 2015-03-03 14:18:16Z maronga
208	! Added support for land surface model and radiation model data.
209	!
210	! 1359 2014-04-11 17:15:14Z hoffmann
211	! New particle structure integrated.
212	!
213	! 1353 2014-04-08 15:21:23Z heinze
214	! REAL constants provided with KIND-attribute
215	!
216	! 1320 2014-03-20 08:40:49Z raasch
217	! ONLY-attribute added to USE-statements,
218	! kind-parameters added to all INTEGER and REAL declaration statements,
219	! kinds are defined in new module kinds,
220	! old module precision_kind is removed,
221	! revision history before 2012 removed,
222	! comment fields (!:) to be used for variable explanations added to
223	! all variable declaration statements
224	!
225	! 1318 2014-03-17 13:35:16Z raasch
226	! barrier argument removed from cpu_log,
227	! module interfaces removed
228	!
229	! 1115 2013-03-26 18:16:16Z hoffmann
230	! ql is calculated by calc_liquid_water_content
231	!
232	! 1053 2012-11-13 17:11:03Z hoffmann
233	! +nr, prr, qr
234	!
235	! 1036 2012-10-22 13:43:42Z raasch
236	! code put under GPL (PALM 3.9)
237	!
238	! 1007 2012-09-19 14:30:36Z franke
239	! Bugfix in calculation of ql_vp
240	!
241	! 978 2012-08-09 08:28:32Z fricke
242	! +z0h*
243	!
244	! Revision 1.1 2006/02/23 12:55:23 raasch
245	! Initial revision
246	!
247	!
248	! Description:
249	! ------------
250	!> Sum-up the values of 3d-arrays. The real averaging is later done in routine
251	!> average_3d_data.
252	!------------------------------------------------------------------------------!
253	SUBROUTINE sum_up_3d_data
254
255
256	USE arrays_3d, &
257	ONLY: dzw, d_exner, e, heatflux_output_conversion, p, &
258	pt, q, ql, ql_c, ql_v, s, u, v, vpt, w, &
259	waterflux_output_conversion
260
261	USE averaging, &
262	ONLY: e_av, ghf_av, lpt_av, lwp_av, ol_av, p_av, pc_av, pr_av, pt_av, &
263	pt_2m_av, q_av, ql_av, ql_c_av, ql_v_av, ql_vp_av, qsws_av, &
264	qv_av, r_a_av, s_av, shf_av, ssws_av, ts_av, tsurf_av, u_av, &
265	us_av, v_av, vpt_av, w_av, z0_av, z0h_av, z0q_av
266
267	USE basic_constants_and_equations_mod, &
268	ONLY: c_p, lv_d_cp, l_v
269
270	USE bulk_cloud_model_mod, &
271	ONLY: bulk_cloud_model
272
273	USE control_parameters, &
274	ONLY: average_count_3d, doav, doav_n, rho_surface, urban_surface, &
275	varnamelength
276
277	USE cpulog, &
278	ONLY: cpu_log, log_point
279
280	USE indices, &
281	ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
282
283	USE kinds
284
285	USE module_interface, &
286	ONLY: module_interface_3d_data_averaging
287
288	USE particle_attributes, &
289	ONLY: grid_particles, number_of_particles, particles, prt_count
290
291	USE surface_mod, &
292	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, &
293	surf_def_h, surf_lsm_h, surf_usm_h
294
295	USE turbulence_closure_mod, &
296	ONLY: tcm_3d_data_averaging
297
298	USE urban_surface_mod, &
299	ONLY: usm_3d_data_averaging
300
301
302	IMPLICIT NONE
303
304	LOGICAL :: match_def !< flag indicating default-type surface
305	LOGICAL :: match_lsm !< flag indicating natural-type surface
306	LOGICAL :: match_usm !< flag indicating urban-type surface
307
308	INTEGER(iwp) :: i !< grid index x direction
309	INTEGER(iwp) :: ii !< running index
310	INTEGER(iwp) :: j !< grid index y direction
311	INTEGER(iwp) :: k !< grid index x direction
312	INTEGER(iwp) :: m !< running index over surfacle elements
313	INTEGER(iwp) :: n !< running index over number of particles per grid box
314
315	REAL(wp) :: mean_r !< mean-particle radius witin grid box
316	REAL(wp) :: s_r2 !< mean-particle radius witin grid box to the power of two
317	REAL(wp) :: s_r3 !< mean-particle radius witin grid box to the power of three
318
319	CHARACTER (LEN=varnamelength) :: trimvar !< TRIM of output-variable string
320
321
322	CALL cpu_log (log_point(34),'sum_up_3d_data','start')
323
324	!
325	!-- Allocate and initialize the summation arrays if called for the very first
326	!-- time or the first time after average_3d_data has been called
327	!-- (some or all of the arrays may have been already allocated
328	!-- in rrd_local)
329	IF ( average_count_3d == 0 ) THEN
330
331	DO ii = 1, doav_n
332
333	trimvar = TRIM( doav(ii) )
334
335	SELECT CASE ( trimvar )
336
337	CASE ( 'ghf*' )
338	IF ( .NOT. ALLOCATED( ghf_av ) ) THEN
339	ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
340	ENDIF
341	ghf_av = 0.0_wp
342
343	CASE ( 'e' )
344	IF ( .NOT. ALLOCATED( e_av ) ) THEN
345	ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
346	ENDIF
347	e_av = 0.0_wp
348
349	CASE ( 'thetal' )
350	IF ( .NOT. ALLOCATED( lpt_av ) ) THEN
351	ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
352	ENDIF
353	lpt_av = 0.0_wp
354
355	CASE ( 'lwp*' )
356	IF ( .NOT. ALLOCATED( lwp_av ) ) THEN
357	ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
358	ENDIF
359	lwp_av = 0.0_wp
360
361	CASE ( 'ol*' )
362	IF ( .NOT. ALLOCATED( ol_av ) ) THEN
363	ALLOCATE( ol_av(nysg:nyng,nxlg:nxrg) )
364	ENDIF
365	ol_av = 0.0_wp
366
367	CASE ( 'p' )
368	IF ( .NOT. ALLOCATED( p_av ) ) THEN
369	ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
370	ENDIF
371	p_av = 0.0_wp
372
373	CASE ( 'pc' )
374	IF ( .NOT. ALLOCATED( pc_av ) ) THEN
375	ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
376	ENDIF
377	pc_av = 0.0_wp
378
379	CASE ( 'pr' )
380	IF ( .NOT. ALLOCATED( pr_av ) ) THEN
381	ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
382	ENDIF
383	pr_av = 0.0_wp
384
385	CASE ( 'theta' )
386	IF ( .NOT. ALLOCATED( pt_av ) ) THEN
387	ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
388	ENDIF
389	pt_av = 0.0_wp
390
391	CASE ( 'q' )
392	IF ( .NOT. ALLOCATED( q_av ) ) THEN
393	ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
394	ENDIF
395	q_av = 0.0_wp
396
397	CASE ( 'ql' )
398	IF ( .NOT. ALLOCATED( ql_av ) ) THEN
399	ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
400	ENDIF
401	ql_av = 0.0_wp
402
403	CASE ( 'ql_c' )
404	IF ( .NOT. ALLOCATED( ql_c_av ) ) THEN
405	ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
406	ENDIF
407	ql_c_av = 0.0_wp
408
409	CASE ( 'ql_v' )
410	IF ( .NOT. ALLOCATED( ql_v_av ) ) THEN
411	ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
412	ENDIF
413	ql_v_av = 0.0_wp
414
415	CASE ( 'ql_vp' )
416	IF ( .NOT. ALLOCATED( ql_vp_av ) ) THEN
417	ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
418	ENDIF
419	ql_vp_av = 0.0_wp
420
421	CASE ( 'qsws*' )
422	IF ( .NOT. ALLOCATED( qsws_av ) ) THEN
423	ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
424	ENDIF
425	qsws_av = 0.0_wp
426
427	CASE ( 'qv' )
428	IF ( .NOT. ALLOCATED( qv_av ) ) THEN
429	ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
430	ENDIF
431	qv_av = 0.0_wp
432
433	CASE ( 'r_a*' )
434	IF ( .NOT. ALLOCATED( r_a_av ) ) THEN
435	ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
436	ENDIF
437	r_a_av = 0.0_wp
438
439	CASE ( 's' )
440	IF ( .NOT. ALLOCATED( s_av ) ) THEN
441	ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
442	ENDIF
443	s_av = 0.0_wp
444
445	CASE ( 'shf*' )
446	IF ( .NOT. ALLOCATED( shf_av ) ) THEN
447	ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
448	ENDIF
449	shf_av = 0.0_wp
450
451	CASE ( 'ssws*' )
452	IF ( .NOT. ALLOCATED( ssws_av ) ) THEN
453	ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
454	ENDIF
455	ssws_av = 0.0_wp
456
457	CASE ( 't*' )
458	IF ( .NOT. ALLOCATED( ts_av ) ) THEN
459	ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
460	ENDIF
461	ts_av = 0.0_wp
462
463	CASE ( 'tsurf*' )
464	IF ( .NOT. ALLOCATED( tsurf_av ) ) THEN
465	ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
466	ENDIF
467	tsurf_av = 0.0_wp
468
469	CASE ( 'u' )
470	IF ( .NOT. ALLOCATED( u_av ) ) THEN
471	ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
472	ENDIF
473	u_av = 0.0_wp
474
475	CASE ( 'us*' )
476	IF ( .NOT. ALLOCATED( us_av ) ) THEN
477	ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
478	ENDIF
479	us_av = 0.0_wp
480
481	CASE ( 'v' )
482	IF ( .NOT. ALLOCATED( v_av ) ) THEN
483	ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
484	ENDIF
485	v_av = 0.0_wp
486
487	CASE ( 'thetav' )
488	IF ( .NOT. ALLOCATED( vpt_av ) ) THEN
489	ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
490	ENDIF
491	vpt_av = 0.0_wp
492
493	CASE ( 'theta_2m*' )
494	IF ( .NOT. ALLOCATED( pt_2m_av ) ) THEN
495	ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
496	ENDIF
497	pt_2m_av = 0.0_wp
498
499	CASE ( 'w' )
500	IF ( .NOT. ALLOCATED( w_av ) ) THEN
501	ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
502	ENDIF
503	w_av = 0.0_wp
504
505	CASE ( 'z0*' )
506	IF ( .NOT. ALLOCATED( z0_av ) ) THEN
507	ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
508	ENDIF
509	z0_av = 0.0_wp
510
511	CASE ( 'z0h*' )
512	IF ( .NOT. ALLOCATED( z0h_av ) ) THEN
513	ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
514	ENDIF
515	z0h_av = 0.0_wp
516
517	CASE ( 'z0q*' )
518	IF ( .NOT. ALLOCATED( z0q_av ) ) THEN
519	ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
520	ENDIF
521	z0q_av = 0.0_wp
522
523
524	CASE DEFAULT
525
526	!
527	!-- Allocating and initializing data arrays for turbulence closure module
528	CALL tcm_3d_data_averaging( 'allocate', trimvar )
529
530	!
531	!-- Allocating and initializing data arrays for all other modules
532	CALL module_interface_3d_data_averaging( 'allocate', trimvar )
533
534
535	END SELECT
536
537	ENDDO
538
539	ENDIF
540
541	!
542	!-- Loop of all variables to be averaged.
543	DO ii = 1, doav_n
544
545	trimvar = TRIM( doav(ii) )
546	!
547	!-- Store the array chosen on the temporary array.
548	SELECT CASE ( trimvar )
549
550	CASE ( 'ghf*' )
551	IF ( ALLOCATED( ghf_av ) ) THEN
552	DO i = nxl, nxr
553	DO j = nys, nyn
554	!
555	!-- Check whether grid point is a natural- or urban-type
556	!-- surface.
557	match_lsm = surf_lsm_h%start_index(j,i) <= &
558	surf_lsm_h%end_index(j,i)
559	match_usm = surf_usm_h%start_index(j,i) <= &
560	surf_usm_h%end_index(j,i)
561	!
562	!-- In order to avoid double-counting of surface properties,
563	!-- always assume that natural-type surfaces are below urban-
564	!-- type surfaces, e.g. in case of bridges.
565	!-- Further, take only the last suface element, i.e. the
566	!-- uppermost surface which would be visible from above
567	IF ( match_lsm .AND. .NOT. match_usm ) THEN
568	m = surf_lsm_h%end_index(j,i)
569	ghf_av(j,i) = ghf_av(j,i) + &
570	surf_lsm_h%ghf(m)
571	ELSEIF ( match_usm ) THEN
572	m = surf_usm_h%end_index(j,i)
573	ghf_av(j,i) = ghf_av(j,i) + &
574	surf_usm_h%frac(ind_veg_wall,m) * &
575	surf_usm_h%wghf_eb(m) + &
576	surf_usm_h%frac(ind_pav_green,m) * &
577	surf_usm_h%wghf_eb_green(m) + &
578	surf_usm_h%frac(ind_wat_win,m) * &
579	surf_usm_h%wghf_eb_window(m)
580	ENDIF
581	ENDDO
582	ENDDO
583	ENDIF
584
585	CASE ( 'e' )
586	IF ( ALLOCATED( e_av ) ) THEN
587	DO i = nxlg, nxrg
588	DO j = nysg, nyng
589	DO k = nzb, nzt+1
590	e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
591	ENDDO
592	ENDDO
593	ENDDO
594	ENDIF
595
596	CASE ( 'thetal' )
597	IF ( ALLOCATED( lpt_av ) ) THEN
598	DO i = nxlg, nxrg
599	DO j = nysg, nyng
600	DO k = nzb, nzt+1
601	lpt_av(k,j,i) = lpt_av(k,j,i) + pt(k,j,i)
602	ENDDO
603	ENDDO
604	ENDDO
605	ENDIF
606
607	CASE ( 'lwp*' )
608	IF ( ALLOCATED( lwp_av ) ) THEN
609	DO i = nxlg, nxrg
610	DO j = nysg, nyng
611	lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) &
612	* dzw(1:nzt+1) ) * rho_surface
613	ENDDO
614	ENDDO
615	ENDIF
616
617	CASE ( 'ol*' )
618	IF ( ALLOCATED( ol_av ) ) THEN
619	DO i = nxl, nxr
620	DO j = nys, nyn
621	match_def = surf_def_h(0)%start_index(j,i) <= &
622	surf_def_h(0)%end_index(j,i)
623	match_lsm = surf_lsm_h%start_index(j,i) <= &
624	surf_lsm_h%end_index(j,i)
625	match_usm = surf_usm_h%start_index(j,i) <= &
626	surf_usm_h%end_index(j,i)
627
628	IF ( match_def ) THEN
629	m = surf_def_h(0)%end_index(j,i)
630	ol_av(j,i) = ol_av(j,i) + &
631	surf_def_h(0)%ol(m)
632	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
633	m = surf_lsm_h%end_index(j,i)
634	ol_av(j,i) = ol_av(j,i) + &
635	surf_lsm_h%ol(m)
636	ELSEIF ( match_usm ) THEN
637	m = surf_usm_h%end_index(j,i)
638	ol_av(j,i) = ol_av(j,i) + &
639	surf_usm_h%ol(m)
640	ENDIF
641	ENDDO
642	ENDDO
643	ENDIF
644
645	CASE ( 'p' )
646	IF ( ALLOCATED( p_av ) ) THEN
647	DO i = nxlg, nxrg
648	DO j = nysg, nyng
649	DO k = nzb, nzt+1
650	p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
651	ENDDO
652	ENDDO
653	ENDDO
654	ENDIF
655
656	CASE ( 'pc' )
657	IF ( ALLOCATED( pc_av ) ) THEN
658	DO i = nxl, nxr
659	DO j = nys, nyn
660	DO k = nzb, nzt+1
661	pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
662	ENDDO
663	ENDDO
664	ENDDO
665	ENDIF
666
667	CASE ( 'pr' )
668	IF ( ALLOCATED( pr_av ) ) THEN
669	DO i = nxl, nxr
670	DO j = nys, nyn
671	DO k = nzb, nzt+1
672	number_of_particles = prt_count(k,j,i)
673	IF ( number_of_particles <= 0 ) CYCLE
674	particles => &
675	grid_particles(k,j,i)%particles(1:number_of_particles)
676	s_r2 = 0.0_wp
677	s_r3 = 0.0_wp
678
679	DO n = 1, number_of_particles
680	IF ( particles(n)%particle_mask ) THEN
681	s_r2 = s_r2 + particles(n)%radius*2 &
682	particles(n)%weight_factor
683	s_r3 = s_r3 + particles(n)%radius*3 &
684	particles(n)%weight_factor
685	ENDIF
686	ENDDO
687
688	IF ( s_r2 > 0.0_wp ) THEN
689	mean_r = s_r3 / s_r2
690	ELSE
691	mean_r = 0.0_wp
692	ENDIF
693	pr_av(k,j,i) = pr_av(k,j,i) + mean_r
694	ENDDO
695	ENDDO
696	ENDDO
697	ENDIF
698
699	CASE ( 'theta' )
700	IF ( ALLOCATED( pt_av ) ) THEN
701	IF ( .NOT. bulk_cloud_model ) THEN
702	DO i = nxlg, nxrg
703	DO j = nysg, nyng
704	DO k = nzb, nzt+1
705	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
706	ENDDO
707	ENDDO
708	ENDDO
709	ELSE
710	DO i = nxlg, nxrg
711	DO j = nysg, nyng
712	DO k = nzb, nzt+1
713	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + lv_d_cp * &
714	d_exner(k) * ql(k,j,i)
715	ENDDO
716	ENDDO
717	ENDDO
718	ENDIF
719	ENDIF
720
721	CASE ( 'q' )
722	IF ( ALLOCATED( q_av ) ) THEN
723	DO i = nxlg, nxrg
724	DO j = nysg, nyng
725	DO k = nzb, nzt+1
726	q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
727	ENDDO
728	ENDDO
729	ENDDO
730	ENDIF
731
732	CASE ( 'ql' )
733	IF ( ALLOCATED( ql_av ) ) THEN
734	DO i = nxlg, nxrg
735	DO j = nysg, nyng
736	DO k = nzb, nzt+1
737	ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
738	ENDDO
739	ENDDO
740	ENDDO
741	ENDIF
742
743	CASE ( 'ql_c' )
744	IF ( ALLOCATED( ql_c_av ) ) THEN
745	DO i = nxlg, nxrg
746	DO j = nysg, nyng
747	DO k = nzb, nzt+1
748	ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
749	ENDDO
750	ENDDO
751	ENDDO
752	ENDIF
753
754	CASE ( 'ql_v' )
755	IF ( ALLOCATED( ql_v_av ) ) THEN
756	DO i = nxlg, nxrg
757	DO j = nysg, nyng
758	DO k = nzb, nzt+1
759	ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
760	ENDDO
761	ENDDO
762	ENDDO
763	ENDIF
764
765	CASE ( 'ql_vp' )
766	IF ( ALLOCATED( ql_vp_av ) ) THEN
767	DO i = nxl, nxr
768	DO j = nys, nyn
769	DO k = nzb, nzt+1
770	number_of_particles = prt_count(k,j,i)
771	IF ( number_of_particles <= 0 ) CYCLE
772	particles => &
773	grid_particles(k,j,i)%particles(1:number_of_particles)
774	DO n = 1, number_of_particles
775	IF ( particles(n)%particle_mask ) THEN
776	ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + &
777	particles(n)%weight_factor / &
778	number_of_particles
779	ENDIF
780	ENDDO
781	ENDDO
782	ENDDO
783	ENDDO
784	ENDIF
785
786	CASE ( 'qsws*' )
787	!
788	!-- In case of default surfaces, clean-up flux by density.
789	!-- In case of land- and urban-surfaces, convert fluxes into
790	!-- dynamic units.
791	IF ( ALLOCATED( qsws_av ) ) THEN
792	DO i = nxl, nxr
793	DO j = nys, nyn
794	match_def = surf_def_h(0)%start_index(j,i) <= &
795	surf_def_h(0)%end_index(j,i)
796	match_lsm = surf_lsm_h%start_index(j,i) <= &
797	surf_lsm_h%end_index(j,i)
798	match_usm = surf_usm_h%start_index(j,i) <= &
799	surf_usm_h%end_index(j,i)
800
801	IF ( match_def ) THEN
802	m = surf_def_h(0)%end_index(j,i)
803	qsws_av(j,i) = qsws_av(j,i) + &
804	surf_def_h(0)%qsws(m) * &
805	waterflux_output_conversion(nzb)
806	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
807	m = surf_lsm_h%end_index(j,i)
808	qsws_av(j,i) = qsws_av(j,i) + &
809	surf_lsm_h%qsws(m) * l_v
810	ENDIF
811	ENDDO
812	ENDDO
813	ENDIF
814
815	CASE ( 'qv' )
816	IF ( ALLOCATED( qv_av ) ) THEN
817	DO i = nxlg, nxrg
818	DO j = nysg, nyng
819	DO k = nzb, nzt+1
820	qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
821	ENDDO
822	ENDDO
823	ENDDO
824	ENDIF
825
826	CASE ( 'r_a*' )
827	IF ( ALLOCATED( r_a_av ) ) THEN
828	DO i = nxl, nxr
829	DO j = nys, nyn
830	match_lsm = surf_lsm_h%start_index(j,i) <= &
831	surf_lsm_h%end_index(j,i)
832	match_usm = surf_usm_h%start_index(j,i) <= &
833	surf_usm_h%end_index(j,i)
834
835	IF ( match_lsm .AND. .NOT. match_usm ) THEN
836	m = surf_lsm_h%end_index(j,i)
837	r_a_av(j,i) = r_a_av(j,i) + &
838	surf_lsm_h%r_a(m)
839	ELSEIF ( match_usm ) THEN
840	m = surf_usm_h%end_index(j,i)
841	r_a_av(j,i) = r_a_av(j,i) + &
842	surf_usm_h%frac(ind_veg_wall,m) * &
843	surf_usm_h%r_a(m) + &
844	surf_usm_h%frac(ind_pav_green,m) * &
845	surf_usm_h%r_a_green(m) + &
846	surf_usm_h%frac(ind_wat_win,m) * &
847	surf_usm_h%r_a_window(m)
848	ENDIF
849	ENDDO
850	ENDDO
851	ENDIF
852
853	CASE ( 's' )
854	IF ( ALLOCATED( s_av ) ) THEN
855	DO i = nxlg, nxrg
856	DO j = nysg, nyng
857	DO k = nzb, nzt+1
858	s_av(k,j,i) = s_av(k,j,i) + s(k,j,i)
859	ENDDO
860	ENDDO
861	ENDDO
862	ENDIF
863
864	CASE ( 'shf*' )
865	!
866	!-- In case of default surfaces, clean-up flux by density.
867	!-- In case of land- and urban-surfaces, convert fluxes into
868	!-- dynamic units.
869	IF ( ALLOCATED( shf_av ) ) THEN
870	DO i = nxl, nxr
871	DO j = nys, nyn
872	match_def = surf_def_h(0)%start_index(j,i) <= &
873	surf_def_h(0)%end_index(j,i)
874	match_lsm = surf_lsm_h%start_index(j,i) <= &
875	surf_lsm_h%end_index(j,i)
876	match_usm = surf_usm_h%start_index(j,i) <= &
877	surf_usm_h%end_index(j,i)
878
879	IF ( match_def ) THEN
880	m = surf_def_h(0)%end_index(j,i)
881	shf_av(j,i) = shf_av(j,i) + &
882	surf_def_h(0)%shf(m) * &
883	heatflux_output_conversion(nzb)
884	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
885	m = surf_lsm_h%end_index(j,i)
886	shf_av(j,i) = shf_av(j,i) + &
887	surf_lsm_h%shf(m) * c_p
888	ELSEIF ( match_usm ) THEN
889	m = surf_usm_h%end_index(j,i)
890	shf_av(j,i) = shf_av(j,i) + &
891	surf_usm_h%shf(m) * c_p
892	ENDIF
893	ENDDO
894	ENDDO
895	ENDIF
896
897	CASE ( 'ssws*' )
898	IF ( ALLOCATED( ssws_av ) ) THEN
899	DO i = nxl, nxr
900	DO j = nys, nyn
901	match_def = surf_def_h(0)%start_index(j,i) <= &
902	surf_def_h(0)%end_index(j,i)
903	match_lsm = surf_lsm_h%start_index(j,i) <= &
904	surf_lsm_h%end_index(j,i)
905	match_usm = surf_usm_h%start_index(j,i) <= &
906	surf_usm_h%end_index(j,i)
907
908	IF ( match_def ) THEN
909	m = surf_def_h(0)%end_index(j,i)
910	ssws_av(j,i) = ssws_av(j,i) + &
911	surf_def_h(0)%ssws(m)
912	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
913	m = surf_lsm_h%end_index(j,i)
914	ssws_av(j,i) = ssws_av(j,i) + &
915	surf_lsm_h%ssws(m)
916	ELSEIF ( match_usm ) THEN
917	m = surf_usm_h%end_index(j,i)
918	ssws_av(j,i) = ssws_av(j,i) + &
919	surf_usm_h%ssws(m)
920	ENDIF
921	ENDDO
922	ENDDO
923	ENDIF
924
925	CASE ( 'theta_2m*' )
926	IF ( ALLOCATED( pt_2m_av ) ) THEN
927	DO i = nxl, nxr
928	DO j = nys, nyn
929	match_def = surf_def_h(0)%start_index(j,i) <= &
930	surf_def_h(0)%end_index(j,i)
931	match_lsm = surf_lsm_h%start_index(j,i) <= &
932	surf_lsm_h%end_index(j,i)
933	match_usm = surf_usm_h%start_index(j,i) <= &
934	surf_usm_h%end_index(j,i)
935
936	IF ( match_def ) THEN
937	m = surf_def_h(0)%end_index(j,i)
938	pt_2m_av(j,i) = pt_2m_av(j,i) + &
939	surf_def_h(0)%pt_2m(m)
940	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
941	m = surf_lsm_h%end_index(j,i)
942	pt_2m_av(j,i) = pt_2m_av(j,i) + &
943	surf_lsm_h%pt_2m(m)
944	ELSEIF ( match_usm ) THEN
945	m = surf_usm_h%end_index(j,i)
946	pt_2m_av(j,i) = pt_2m_av(j,i) + &
947	surf_usm_h%pt_2m(m)
948	ENDIF
949	ENDDO
950	ENDDO
951	ENDIF
952
953
954	CASE ( 't*' )
955	IF ( ALLOCATED( ts_av ) ) THEN
956	DO i = nxl, nxr
957	DO j = nys, nyn
958	match_def = surf_def_h(0)%start_index(j,i) <= &
959	surf_def_h(0)%end_index(j,i)
960	match_lsm = surf_lsm_h%start_index(j,i) <= &
961	surf_lsm_h%end_index(j,i)
962	match_usm = surf_usm_h%start_index(j,i) <= &
963	surf_usm_h%end_index(j,i)
964
965	IF ( match_def ) THEN
966	m = surf_def_h(0)%end_index(j,i)
967	ts_av(j,i) = ts_av(j,i) + &
968	surf_def_h(0)%ts(m)
969	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
970	m = surf_lsm_h%end_index(j,i)
971	ts_av(j,i) = ts_av(j,i) + &
972	surf_lsm_h%ts(m)
973	ELSEIF ( match_usm ) THEN
974	m = surf_usm_h%end_index(j,i)
975	ts_av(j,i) = ts_av(j,i) + &
976	surf_usm_h%ts(m)
977	ENDIF
978	ENDDO
979	ENDDO
980	ENDIF
981
982	CASE ( 'tsurf*' )
983	IF ( ALLOCATED( tsurf_av ) ) THEN
984	DO i = nxl, nxr
985	DO j = nys, nyn
986	match_def = surf_def_h(0)%start_index(j,i) <= &
987	surf_def_h(0)%end_index(j,i)
988	match_lsm = surf_lsm_h%start_index(j,i) <= &
989	surf_lsm_h%end_index(j,i)
990	match_usm = surf_usm_h%start_index(j,i) <= &
991	surf_usm_h%end_index(j,i)
992
993	IF ( match_def ) THEN
994	m = surf_def_h(0)%end_index(j,i)
995	tsurf_av(j,i) = tsurf_av(j,i) + &
996	surf_def_h(0)%pt_surface(m)
997	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
998	m = surf_lsm_h%end_index(j,i)
999	tsurf_av(j,i) = tsurf_av(j,i) + &
1000	surf_lsm_h%pt_surface(m)
1001	ELSEIF ( match_usm ) THEN
1002	m = surf_usm_h%end_index(j,i)
1003	tsurf_av(j,i) = tsurf_av(j,i) + &
1004	surf_usm_h%pt_surface(m)
1005	ENDIF
1006	ENDDO
1007	ENDDO
1008	ENDIF
1009
1010	CASE ( 'u' )
1011	IF ( ALLOCATED( u_av ) ) THEN
1012	DO i = nxlg, nxrg
1013	DO j = nysg, nyng
1014	DO k = nzb, nzt+1
1015	u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
1016	ENDDO
1017	ENDDO
1018	ENDDO
1019	ENDIF
1020
1021	CASE ( 'us*' )
1022	IF ( ALLOCATED( us_av ) ) THEN
1023	DO i = nxl, nxr
1024	DO j = nys, nyn
1025	match_def = surf_def_h(0)%start_index(j,i) <= &
1026	surf_def_h(0)%end_index(j,i)
1027	match_lsm = surf_lsm_h%start_index(j,i) <= &
1028	surf_lsm_h%end_index(j,i)
1029	match_usm = surf_usm_h%start_index(j,i) <= &
1030	surf_usm_h%end_index(j,i)
1031
1032	IF ( match_def ) THEN
1033	m = surf_def_h(0)%end_index(j,i)
1034	us_av(j,i) = us_av(j,i) + &
1035	surf_def_h(0)%us(m)
1036	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
1037	m = surf_lsm_h%end_index(j,i)
1038	us_av(j,i) = us_av(j,i) + &
1039	surf_lsm_h%us(m)
1040	ELSEIF ( match_usm ) THEN
1041	m = surf_usm_h%end_index(j,i)
1042	us_av(j,i) = us_av(j,i) + &
1043	surf_usm_h%us(m)
1044	ENDIF
1045	ENDDO
1046	ENDDO
1047	ENDIF
1048
1049	CASE ( 'v' )
1050	IF ( ALLOCATED( v_av ) ) THEN
1051	DO i = nxlg, nxrg
1052	DO j = nysg, nyng
1053	DO k = nzb, nzt+1
1054	v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
1055	ENDDO
1056	ENDDO
1057	ENDDO
1058	ENDIF
1059
1060	CASE ( 'thetav' )
1061	IF ( ALLOCATED( vpt_av ) ) THEN
1062	DO i = nxlg, nxrg
1063	DO j = nysg, nyng
1064	DO k = nzb, nzt+1
1065	vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
1066	ENDDO
1067	ENDDO
1068	ENDDO
1069	ENDIF
1070
1071	CASE ( 'w' )
1072	IF ( ALLOCATED( w_av ) ) THEN
1073	DO i = nxlg, nxrg
1074	DO j = nysg, nyng
1075	DO k = nzb, nzt+1
1076	w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
1077	ENDDO
1078	ENDDO
1079	ENDDO
1080	ENDIF
1081
1082	CASE ( 'z0*' )
1083	IF ( ALLOCATED( z0_av ) ) THEN
1084	DO i = nxl, nxr
1085	DO j = nys, nyn
1086	match_def = surf_def_h(0)%start_index(j,i) <= &
1087	surf_def_h(0)%end_index(j,i)
1088	match_lsm = surf_lsm_h%start_index(j,i) <= &
1089	surf_lsm_h%end_index(j,i)
1090	match_usm = surf_usm_h%start_index(j,i) <= &
1091	surf_usm_h%end_index(j,i)
1092
1093	IF ( match_def ) THEN
1094	m = surf_def_h(0)%end_index(j,i)
1095	z0_av(j,i) = z0_av(j,i) + &
1096	surf_def_h(0)%z0(m)
1097	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
1098	m = surf_lsm_h%end_index(j,i)
1099	z0_av(j,i) = z0_av(j,i) + &
1100	surf_lsm_h%z0(m)
1101	ELSEIF ( match_usm ) THEN
1102	m = surf_usm_h%end_index(j,i)
1103	z0_av(j,i) = z0_av(j,i) + &
1104	surf_usm_h%z0(m)
1105	ENDIF
1106	ENDDO
1107	ENDDO
1108	ENDIF
1109
1110	CASE ( 'z0h*' )
1111	IF ( ALLOCATED( z0h_av ) ) THEN
1112	DO i = nxl, nxr
1113	DO j = nys, nyn
1114	match_def = surf_def_h(0)%start_index(j,i) <= &
1115	surf_def_h(0)%end_index(j,i)
1116	match_lsm = surf_lsm_h%start_index(j,i) <= &
1117	surf_lsm_h%end_index(j,i)
1118	match_usm = surf_usm_h%start_index(j,i) <= &
1119	surf_usm_h%end_index(j,i)
1120
1121	IF ( match_def ) THEN
1122	m = surf_def_h(0)%end_index(j,i)
1123	z0h_av(j,i) = z0h_av(j,i) + &
1124	surf_def_h(0)%z0h(m)
1125	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
1126	m = surf_lsm_h%end_index(j,i)
1127	z0h_av(j,i) = z0h_av(j,i) + &
1128	surf_lsm_h%z0h(m)
1129	ELSEIF ( match_usm ) THEN
1130	m = surf_usm_h%end_index(j,i)
1131	z0h_av(j,i) = z0h_av(j,i) + &
1132	surf_usm_h%z0h(m)
1133	ENDIF
1134	ENDDO
1135	ENDDO
1136	ENDIF
1137
1138	CASE ( 'z0q*' )
1139	IF ( ALLOCATED( z0q_av ) ) THEN
1140	DO i = nxl, nxr
1141	DO j = nys, nyn
1142	match_def = surf_def_h(0)%start_index(j,i) <= &
1143	surf_def_h(0)%end_index(j,i)
1144	match_lsm = surf_lsm_h%start_index(j,i) <= &
1145	surf_lsm_h%end_index(j,i)
1146	match_usm = surf_usm_h%start_index(j,i) <= &
1147	surf_usm_h%end_index(j,i)
1148
1149	IF ( match_def ) THEN
1150	m = surf_def_h(0)%end_index(j,i)
1151	z0q_av(j,i) = z0q_av(j,i) + &
1152	surf_def_h(0)%z0q(m)
1153	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
1154	m = surf_lsm_h%end_index(j,i)
1155	z0q_av(j,i) = z0q_av(j,i) + &
1156	surf_lsm_h%z0q(m)
1157	ELSEIF ( match_usm ) THEN
1158	m = surf_usm_h%end_index(j,i)
1159	z0q_av(j,i) = z0q_av(j,i) + &
1160	surf_usm_h%z0q(m)
1161	ENDIF
1162	ENDDO
1163	ENDDO
1164	ENDIF
1165
1166	CASE DEFAULT
1167
1168	!-- In case of urban surface variables it should be always checked
1169	!-- if respective arrays are allocated, at least in case of a restart
1170	!-- run, as averaged usm arrays are not read from file at the moment.
1171	IF ( urban_surface ) THEN
1172	CALL usm_3d_data_averaging( 'allocate', trimvar )
1173	ENDIF
1174
1175	!
1176	!-- Summing up data from turbulence closure module
1177	CALL tcm_3d_data_averaging( 'sum', trimvar )
1178
1179	!
1180	!-- Summing up data from all other modules
1181	CALL module_interface_3d_data_averaging( 'sum', trimvar )
1182
1183
1184	END SELECT
1185
1186	ENDDO
1187
1188	CALL cpu_log( log_point(34), 'sum_up_3d_data', 'stop' )
1189
1190
1191	END SUBROUTINE sum_up_3d_data

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |