Home

Context Navigation

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

Last change on this file since 4788 was 4671, checked in by pavelkrc, 4 years ago
Radiative transfer model RTM version 4.1
Property svn:keywords set to `Id`
File size: 43.3 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 terms of the GNU General
6	! Public License as published by the Free Software Foundation, either version 3 of the License, or
7	! (at your option) any later version.
8	!
9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10	! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11	! Public License for more details.
12	!
13	! You should have received a copy of the GNU General Public License along with PALM. If not, see
14	! <http://www.gnu.org/licenses/>.
15	!
16	! Copyright 1997-2020 Leibniz Universitaet Hannover
17	!--------------------------------------------------------------------------------------------------!
18	!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: sum_up_3d_data.f90 4671 2020-09-09 20:27:58Z oliver.maas $
27	! Implementation of downward facing USM and LSM surfaces
28	!
29	! 4591 2020-07-06 15:56:08Z raasch
30	! File re-formatted to follow the PALM coding standard
31	!
32	! 4516 2020-04-30 16:55:10Z suehring
33	! Remove double index
34	!
35	! 4514 2020-04-30 16:29:59Z suehring
36	! Enable output of qsurf and ssurf
37	!
38	! 4442 2020-03-04 19:21:13Z suehring
39	! Change order of dimension in surface array %frac to allow for better vectorization.
40	!
41	! 4441 2020-03-04 19:20:35Z suehring
42	! Move 2-m potential temperature output to diagnostic_output_quantities
43	!
44	! 4182 2019-08-22 15:20:23Z scharf
45	! Corrected "Former revisions" section
46	!
47	! 4048 2019-06-21 21:00:21Z knoop
48	! Moved tcm_3d_data_averaging to module_interface
49	!
50	! 4039 2019-06-18 10:32:41Z suehring
51	! Modularize diagnostic output
52	!
53	! 3994 2019-05-22 18:08:09Z suehring
54	! Output of turbulence intensity added
55	!
56	! 3943 2019-05-02 09:50:41Z maronga
57	! Added output of qsws_av for green roofs.
58	!
59	! 3933 2019-04-25 12:33:20Z kanani
60	! Formatting
61	!
62	! 3773 2019-03-01 08:56:57Z maronga
63	! Added output of theta_2m*_xy_av
64	!
65	! 3761 2019-02-25 15:31:42Z raasch
66	! unused variables removed
67	!
68	! 3655 2019-01-07 16:51:22Z knoop
69	! Implementation of the PALM module interface
70	!
71	! Revision 1.1 2006/02/23 12:55:23 raasch
72	! Initial revision
73	!
74	!
75	! Description:
76	! ------------
77	!> Sum-up the values of 3d-arrays. The real averaging is later done in routine average_3d_data.
78	!--------------------------------------------------------------------------------------------------!
79	SUBROUTINE sum_up_3d_data
80
81
82	USE arrays_3d, &
83	ONLY: dzw, &
84	d_exner, &
85	e, &
86	heatflux_output_conversion, &
87	p, &
88	pt, &
89	q, &
90	ql, &
91	ql_c, &
92	ql_v, &
93	s, &
94	u, &
95	v, &
96	vpt, &
97	w, &
98	waterflux_output_conversion
99
100	USE averaging, &
101	ONLY: e_av, &
102	ghf_av, &
103	lpt_av, &
104	lwp_av, &
105	ol_av, &
106	p_av, &
107	pc_av, &
108	pr_av, &
109	pt_av, &
110	q_av, &
111	ql_av, &
112	ql_c_av, &
113	ql_v_av, &
114	ql_vp_av, &
115	qsurf_av, &
116	qsws_av, &
117	qv_av, &
118	r_a_av, &
119	s_av, &
120	shf_av, &
121	ssurf_av, &
122	ssws_av, &
123	ts_av, &
124	tsurf_av, &
125	u_av, &
126	us_av, &
127	v_av, &
128	vpt_av, &
129	w_av, &
130	z0_av, &
131	z0h_av, &
132	z0q_av
133
134	USE basic_constants_and_equations_mod, &
135	ONLY: c_p, &
136	lv_d_cp, &
137	l_v
138
139	USE bulk_cloud_model_mod, &
140	ONLY: bulk_cloud_model
141
142	USE control_parameters, &
143	ONLY: average_count_3d, &
144	doav, &
145	doav_n, &
146	rho_surface, &
147	urban_surface, &
148	varnamelength
149
150	USE cpulog, &
151	ONLY: cpu_log, &
152	log_point
153
154	USE indices, &
155	ONLY: nxl, &
156	nxlg, &
157	nxr, &
158	nxrg, &
159	nyn, &
160	nyng, &
161	nys, &
162	nysg, &
163	nzb, &
164	nzt, &
165	topo_top_ind
166
167	USE kinds
168
169	USE module_interface, &
170	ONLY: module_interface_3d_data_averaging
171
172	USE particle_attributes, &
173	ONLY: grid_particles, &
174	number_of_particles, &
175	particles, &
176	prt_count
177
178	USE surface_mod, &
179	ONLY: ind_pav_green, &
180	ind_veg_wall, &
181	ind_wat_win, &
182	surf_def_h, &
183	surf_lsm_h, &
184	surf_usm_h
185
186	USE urban_surface_mod, &
187	ONLY: usm_3d_data_averaging
188
189
190	IMPLICIT NONE
191
192	CHARACTER(LEN=varnamelength) :: trimvar !< TRIM of output-variable string
193
194	INTEGER(iwp) :: i !< grid index x direction
195	INTEGER(iwp) :: ii !< running index
196	INTEGER(iwp) :: j !< grid index y direction
197	INTEGER(iwp) :: k !< grid index x direction
198	INTEGER(iwp) :: m !< running index over surfacle elements
199	INTEGER(iwp) :: n !< running index over number of particles per grid box
200
201	LOGICAL :: match_def !< flag indicating default-type surface
202	LOGICAL :: match_lsm !< flag indicating natural-type surface
203	LOGICAL :: match_usm !< flag indicating urban-type surface
204
205	REAL(wp) :: mean_r !< mean-particle radius witin grid box
206	REAL(wp) :: s_r2 !< mean-particle radius witin grid box to the power of two
207	REAL(wp) :: s_r3 !< mean-particle radius witin grid box to the power of three
208
209
210
211	CALL cpu_log (log_point(34),'sum_up_3d_data','start')
212
213	!
214	!-- Allocate and initialize the summation arrays if called for the very first time or the first time
215	!-- after average_3d_data has been called (some or all of the arrays may have been already allocated
216	!-- in rrd_local)
217	IF ( average_count_3d == 0 ) THEN
218
219	DO ii = 1, doav_n
220
221	trimvar = TRIM( doav(ii) )
222
223	SELECT CASE ( trimvar )
224
225	CASE ( 'ghf*' )
226	IF ( .NOT. ALLOCATED( ghf_av ) ) THEN
227	ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
228	ENDIF
229	ghf_av = 0.0_wp
230
231	CASE ( 'e' )
232	IF ( .NOT. ALLOCATED( e_av ) ) THEN
233	ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
234	ENDIF
235	e_av = 0.0_wp
236
237	CASE ( 'thetal' )
238	IF ( .NOT. ALLOCATED( lpt_av ) ) THEN
239	ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
240	ENDIF
241	lpt_av = 0.0_wp
242
243	CASE ( 'lwp*' )
244	IF ( .NOT. ALLOCATED( lwp_av ) ) THEN
245	ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
246	ENDIF
247	lwp_av = 0.0_wp
248
249	CASE ( 'ol*' )
250	IF ( .NOT. ALLOCATED( ol_av ) ) THEN
251	ALLOCATE( ol_av(nysg:nyng,nxlg:nxrg) )
252	ENDIF
253	ol_av = 0.0_wp
254
255	CASE ( 'p' )
256	IF ( .NOT. ALLOCATED( p_av ) ) THEN
257	ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
258	ENDIF
259	p_av = 0.0_wp
260
261	CASE ( 'pc' )
262	IF ( .NOT. ALLOCATED( pc_av ) ) THEN
263	ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
264	ENDIF
265	pc_av = 0.0_wp
266
267	CASE ( 'pr' )
268	IF ( .NOT. ALLOCATED( pr_av ) ) THEN
269	ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
270	ENDIF
271	pr_av = 0.0_wp
272
273	CASE ( 'theta' )
274	IF ( .NOT. ALLOCATED( pt_av ) ) THEN
275	ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
276	ENDIF
277	pt_av = 0.0_wp
278
279	CASE ( 'q' )
280	IF ( .NOT. ALLOCATED( q_av ) ) THEN
281	ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
282	ENDIF
283	q_av = 0.0_wp
284
285	CASE ( 'ql' )
286	IF ( .NOT. ALLOCATED( ql_av ) ) THEN
287	ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
288	ENDIF
289	ql_av = 0.0_wp
290
291	CASE ( 'ql_c' )
292	IF ( .NOT. ALLOCATED( ql_c_av ) ) THEN
293	ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
294	ENDIF
295	ql_c_av = 0.0_wp
296
297	CASE ( 'ql_v' )
298	IF ( .NOT. ALLOCATED( ql_v_av ) ) THEN
299	ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
300	ENDIF
301	ql_v_av = 0.0_wp
302
303	CASE ( 'ql_vp' )
304	IF ( .NOT. ALLOCATED( ql_vp_av ) ) THEN
305	ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
306	ENDIF
307	ql_vp_av = 0.0_wp
308
309	CASE ( 'qsurf*' )
310	IF ( .NOT. ALLOCATED( qsurf_av ) ) THEN
311	ALLOCATE( qsurf_av(nysg:nyng,nxlg:nxrg) )
312	ENDIF
313	qsurf_av = 0.0_wp
314
315	CASE ( 'qsws*' )
316	IF ( .NOT. ALLOCATED( qsws_av ) ) THEN
317	ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
318	ENDIF
319	qsws_av = 0.0_wp
320
321	CASE ( 'qv' )
322	IF ( .NOT. ALLOCATED( qv_av ) ) THEN
323	ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
324	ENDIF
325	qv_av = 0.0_wp
326
327	CASE ( 'r_a*' )
328	IF ( .NOT. ALLOCATED( r_a_av ) ) THEN
329	ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
330	ENDIF
331	r_a_av = 0.0_wp
332
333	CASE ( 's' )
334	IF ( .NOT. ALLOCATED( s_av ) ) THEN
335	ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
336	ENDIF
337	s_av = 0.0_wp
338
339	CASE ( 'shf*' )
340	IF ( .NOT. ALLOCATED( shf_av ) ) THEN
341	ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
342	ENDIF
343	shf_av = 0.0_wp
344
345	CASE ( 'ssurf*' )
346	IF ( .NOT. ALLOCATED( ssurf_av ) ) THEN
347	ALLOCATE( ssurf_av(nysg:nyng,nxlg:nxrg) )
348	ENDIF
349	ssurf_av = 0.0_wp
350
351	CASE ( 'ssws*' )
352	IF ( .NOT. ALLOCATED( ssws_av ) ) THEN
353	ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
354	ENDIF
355	ssws_av = 0.0_wp
356
357	CASE ( 't*' )
358	IF ( .NOT. ALLOCATED( ts_av ) ) THEN
359	ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
360	ENDIF
361	ts_av = 0.0_wp
362
363	CASE ( 'tsurf*' )
364	IF ( .NOT. ALLOCATED( tsurf_av ) ) THEN
365	ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
366	ENDIF
367	tsurf_av = 0.0_wp
368
369	CASE ( 'u' )
370	IF ( .NOT. ALLOCATED( u_av ) ) THEN
371	ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
372	ENDIF
373	u_av = 0.0_wp
374
375	CASE ( 'us*' )
376	IF ( .NOT. ALLOCATED( us_av ) ) THEN
377	ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
378	ENDIF
379	us_av = 0.0_wp
380
381	CASE ( 'v' )
382	IF ( .NOT. ALLOCATED( v_av ) ) THEN
383	ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
384	ENDIF
385	v_av = 0.0_wp
386
387	CASE ( 'thetav' )
388	IF ( .NOT. ALLOCATED( vpt_av ) ) THEN
389	ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
390	ENDIF
391	vpt_av = 0.0_wp
392
393	CASE ( 'w' )
394	IF ( .NOT. ALLOCATED( w_av ) ) THEN
395	ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
396	ENDIF
397	w_av = 0.0_wp
398
399	CASE ( 'z0*' )
400	IF ( .NOT. ALLOCATED( z0_av ) ) THEN
401	ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
402	ENDIF
403	z0_av = 0.0_wp
404
405	CASE ( 'z0h*' )
406	IF ( .NOT. ALLOCATED( z0h_av ) ) THEN
407	ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
408	ENDIF
409	z0h_av = 0.0_wp
410
411	CASE ( 'z0q*' )
412	IF ( .NOT. ALLOCATED( z0q_av ) ) THEN
413	ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
414	ENDIF
415	z0q_av = 0.0_wp
416
417
418	CASE DEFAULT
419
420	!
421	!-- Allocating and initializing data arrays for all other modules
422	CALL module_interface_3d_data_averaging( 'allocate', trimvar )
423
424
425	END SELECT
426
427	ENDDO
428
429	ENDIF
430
431	!
432	!-- Loop of all variables to be averaged.
433	DO ii = 1, doav_n
434
435	trimvar = TRIM( doav(ii) )
436	!
437	!-- Store the array chosen on the temporary array.
438	SELECT CASE ( trimvar )
439
440	CASE ( 'ghf*' )
441	IF ( ALLOCATED( ghf_av ) ) THEN
442	DO i = nxl, nxr
443	DO j = nys, nyn
444	!
445	!-- Check whether grid point is a natural- or urban-type surface.
446	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
447	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
448	!
449	!-- In order to avoid double-counting of surface properties, always assume that
450	!-- natural-type surfaces are below urban type surfaces, e.g. in case of bridges.
451	!-- Further, take only the last suface element, i.e. the uppermost surface which
452	!-- would be visible from above
453	IF ( match_lsm .AND. .NOT. match_usm ) THEN
454	m = surf_lsm_h(0)%end_index(j,i)
455	ghf_av(j,i) = ghf_av(j,i) + surf_lsm_h(0)%ghf(m)
456	ELSEIF ( match_usm ) THEN
457	m = surf_usm_h(0)%end_index(j,i)
458	ghf_av(j,i) = ghf_av(j,i) + surf_usm_h(0)%frac(m,ind_veg_wall) * &
459	surf_usm_h(0)%wghf_eb(m) + &
460	surf_usm_h(0)%frac(m,ind_pav_green) * &
461	surf_usm_h(0)%wghf_eb_green(m) + &
462	surf_usm_h(0)%frac(m,ind_wat_win) * &
463	surf_usm_h(0)%wghf_eb_window(m)
464	ENDIF
465	ENDDO
466	ENDDO
467	ENDIF
468
469	CASE ( 'e' )
470	IF ( ALLOCATED( e_av ) ) THEN
471	DO i = nxlg, nxrg
472	DO j = nysg, nyng
473	DO k = nzb, nzt+1
474	e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
475	ENDDO
476	ENDDO
477	ENDDO
478	ENDIF
479
480	CASE ( 'thetal' )
481	IF ( ALLOCATED( lpt_av ) ) THEN
482	DO i = nxlg, nxrg
483	DO j = nysg, nyng
484	DO k = nzb, nzt+1
485	lpt_av(k,j,i) = lpt_av(k,j,i) + pt(k,j,i)
486	ENDDO
487	ENDDO
488	ENDDO
489	ENDIF
490
491	CASE ( 'lwp*' )
492	IF ( ALLOCATED( lwp_av ) ) THEN
493	DO i = nxlg, nxrg
494	DO j = nysg, nyng
495	lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) * dzw(1:nzt+1) ) &
496	* rho_surface
497	ENDDO
498	ENDDO
499	ENDIF
500
501	CASE ( 'ol*' )
502	IF ( ALLOCATED( ol_av ) ) THEN
503	DO i = nxl, nxr
504	DO j = nys, nyn
505	match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
506	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
507	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
508
509	IF ( match_def ) THEN
510	m = surf_def_h(0)%end_index(j,i)
511	ol_av(j,i) = ol_av(j,i) + surf_def_h(0)%ol(m)
512	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
513	m = surf_lsm_h(0)%end_index(j,i)
514	ol_av(j,i) = ol_av(j,i) + surf_lsm_h(0)%ol(m)
515	ELSEIF ( match_usm ) THEN
516	m = surf_usm_h(0)%end_index(j,i)
517	ol_av(j,i) = ol_av(j,i) + surf_usm_h(0)%ol(m)
518	ENDIF
519	ENDDO
520	ENDDO
521	ENDIF
522
523	CASE ( 'p' )
524	IF ( ALLOCATED( p_av ) ) THEN
525	DO i = nxlg, nxrg
526	DO j = nysg, nyng
527	DO k = nzb, nzt+1
528	p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
529	ENDDO
530	ENDDO
531	ENDDO
532	ENDIF
533
534	CASE ( 'pc' )
535	IF ( ALLOCATED( pc_av ) ) THEN
536	DO i = nxl, nxr
537	DO j = nys, nyn
538	DO k = nzb, nzt+1
539	pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
540	ENDDO
541	ENDDO
542	ENDDO
543	ENDIF
544
545	CASE ( 'pr' )
546	IF ( ALLOCATED( pr_av ) ) THEN
547	DO i = nxl, nxr
548	DO j = nys, nyn
549	DO k = nzb, nzt+1
550	number_of_particles = prt_count(k,j,i)
551	IF ( number_of_particles <= 0 ) CYCLE
552	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
553	s_r2 = 0.0_wp
554	s_r3 = 0.0_wp
555
556	DO n = 1, number_of_particles
557	IF ( particles(n)%particle_mask ) THEN
558	s_r2 = s_r2 + particles(n)%radius*2 particles(n)%weight_factor
559	s_r3 = s_r3 + particles(n)%radius*3 particles(n)%weight_factor
560	ENDIF
561	ENDDO
562
563	IF ( s_r2 > 0.0_wp ) THEN
564	mean_r = s_r3 / s_r2
565	ELSE
566	mean_r = 0.0_wp
567	ENDIF
568	pr_av(k,j,i) = pr_av(k,j,i) + mean_r
569	ENDDO
570	ENDDO
571	ENDDO
572	ENDIF
573
574	CASE ( 'theta' )
575	IF ( ALLOCATED( pt_av ) ) THEN
576	IF ( .NOT. bulk_cloud_model ) THEN
577	DO i = nxlg, nxrg
578	DO j = nysg, nyng
579	DO k = nzb, nzt+1
580	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
581	ENDDO
582	ENDDO
583	ENDDO
584	ELSE
585	DO i = nxlg, nxrg
586	DO j = nysg, nyng
587	DO k = nzb, nzt+1
588	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + lv_d_cp * d_exner(k) &
589	* ql(k,j,i)
590	ENDDO
591	ENDDO
592	ENDDO
593	ENDIF
594	ENDIF
595
596	CASE ( 'q' )
597	IF ( ALLOCATED( q_av ) ) THEN
598	DO i = nxlg, nxrg
599	DO j = nysg, nyng
600	DO k = nzb, nzt+1
601	q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
602	ENDDO
603	ENDDO
604	ENDDO
605	ENDIF
606
607	CASE ( 'ql' )
608	IF ( ALLOCATED( ql_av ) ) THEN
609	DO i = nxlg, nxrg
610	DO j = nysg, nyng
611	DO k = nzb, nzt+1
612	ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
613	ENDDO
614	ENDDO
615	ENDDO
616	ENDIF
617
618	CASE ( 'ql_c' )
619	IF ( ALLOCATED( ql_c_av ) ) THEN
620	DO i = nxlg, nxrg
621	DO j = nysg, nyng
622	DO k = nzb, nzt+1
623	ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
624	ENDDO
625	ENDDO
626	ENDDO
627	ENDIF
628
629	CASE ( 'ql_v' )
630	IF ( ALLOCATED( ql_v_av ) ) THEN
631	DO i = nxlg, nxrg
632	DO j = nysg, nyng
633	DO k = nzb, nzt+1
634	ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
635	ENDDO
636	ENDDO
637	ENDDO
638	ENDIF
639
640	CASE ( 'ql_vp' )
641	IF ( ALLOCATED( ql_vp_av ) ) THEN
642	DO i = nxl, nxr
643	DO j = nys, nyn
644	DO k = nzb, nzt+1
645	number_of_particles = prt_count(k,j,i)
646	IF ( number_of_particles <= 0 ) CYCLE
647	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
648	DO n = 1, number_of_particles
649	IF ( particles(n)%particle_mask ) THEN
650	ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + &
651	particles(n)%weight_factor / number_of_particles
652	ENDIF
653	ENDDO
654	ENDDO
655	ENDDO
656	ENDDO
657	ENDIF
658
659	CASE ( 'qsurf*' )
660	IF ( ALLOCATED( qsurf_av ) ) THEN
661	DO i = nxl, nxr
662	DO j = nys, nyn
663	match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
664	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
665	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
666
667	IF ( match_def ) THEN
668	m = surf_def_h(0)%end_index(j,i)
669	qsurf_av(j,i) = qsurf_av(j,i) + surf_def_h(0)%q_surface(m)
670	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
671	m = surf_lsm_h(0)%end_index(j,i)
672	qsurf_av(j,i) = qsurf_av(j,i) + surf_lsm_h(0)%q_surface(m)
673	ELSEIF ( match_usm ) THEN
674	m = surf_usm_h(0)%end_index(j,i)
675	qsurf_av(j,i) = qsurf_av(j,i) + surf_usm_h(0)%q_surface(m)
676	ENDIF
677	ENDDO
678	ENDDO
679	ENDIF
680
681	CASE ( 'qsws*' )
682	!
683	!-- In case of default surfaces, clean-up flux by density.
684	!-- In case of land- and urban-surfaces, convert fluxes into dynamic units.
685	!-- Question (maronga): are the .NOT. statements really required?
686	IF ( ALLOCATED( qsws_av ) ) THEN
687	DO i = nxl, nxr
688	DO j = nys, nyn
689	match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
690	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
691	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
692
693	IF ( match_def ) THEN
694	m = surf_def_h(0)%end_index(j,i)
695	qsws_av(j,i) = qsws_av(j,i) + surf_def_h(0)%qsws(m) * &
696	waterflux_output_conversion(nzb)
697	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
698	m = surf_lsm_h(0)%end_index(j,i)
699	qsws_av(j,i) = qsws_av(j,i) + surf_lsm_h(0)%qsws(m) * l_v
700	ELSEIF ( match_usm .AND. .NOT. match_lsm ) THEN
701	m = surf_usm_h(0)%end_index(j,i)
702	qsws_av(j,i) = qsws_av(j,i) + surf_usm_h(0)%qsws(m) * l_v
703	ENDIF
704	ENDDO
705	ENDDO
706	ENDIF
707
708	CASE ( 'qv' )
709	IF ( ALLOCATED( qv_av ) ) THEN
710	DO i = nxlg, nxrg
711	DO j = nysg, nyng
712	DO k = nzb, nzt+1
713	qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
714	ENDDO
715	ENDDO
716	ENDDO
717	ENDIF
718
719	CASE ( 'r_a*' )
720	IF ( ALLOCATED( r_a_av ) ) THEN
721	DO i = nxl, nxr
722	DO j = nys, nyn
723	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
724	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
725
726	IF ( match_lsm .AND. .NOT. match_usm ) THEN
727	m = surf_lsm_h(0)%end_index(j,i)
728	r_a_av(j,i) = r_a_av(j,i) + surf_lsm_h(0)%r_a(m)
729	ELSEIF ( match_usm ) THEN
730	m = surf_usm_h(0)%end_index(j,i)
731	r_a_av(j,i) = r_a_av(j,i) + surf_usm_h(0)%frac(m,ind_veg_wall) * &
732	surf_usm_h(0)%r_a(m) + &
733	surf_usm_h(0)%frac(m,ind_pav_green) * &
734	surf_usm_h(0)%r_a_green(m) + &
735	surf_usm_h(0)%frac(m,ind_wat_win) * &
736	surf_usm_h(0)%r_a_window(m)
737	ENDIF
738	ENDDO
739	ENDDO
740	ENDIF
741
742	CASE ( 's' )
743	IF ( ALLOCATED( s_av ) ) THEN
744	DO i = nxlg, nxrg
745	DO j = nysg, nyng
746	DO k = nzb, nzt+1
747	s_av(k,j,i) = s_av(k,j,i) + s(k,j,i)
748	ENDDO
749	ENDDO
750	ENDDO
751	ENDIF
752
753	CASE ( 'shf*' )
754	!
755	!-- In case of default surfaces, clean-up flux by density.
756	!-- In case of land- and urban-surfaces, convert fluxes into dynamic units.
757	IF ( ALLOCATED( shf_av ) ) THEN
758	DO i = nxl, nxr
759	DO j = nys, nyn
760	match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
761	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
762	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
763
764	IF ( match_def ) THEN
765	m = surf_def_h(0)%end_index(j,i)
766	shf_av(j,i) = shf_av(j,i) + surf_def_h(0)%shf(m) * &
767	heatflux_output_conversion(nzb)
768	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
769	m = surf_lsm_h(0)%end_index(j,i)
770	shf_av(j,i) = shf_av(j,i) + surf_lsm_h(0)%shf(m) * c_p
771	ELSEIF ( match_usm ) THEN
772	m = surf_usm_h(0)%end_index(j,i)
773	shf_av(j,i) = shf_av(j,i) + surf_usm_h(0)%shf(m) * c_p
774	ENDIF
775	ENDDO
776	ENDDO
777	ENDIF
778
779	CASE ( 'ssurf*' )
780	IF ( ALLOCATED( ssurf_av ) ) THEN
781	DO i = nxl, nxr
782	DO j = nys, nyn
783	k = topo_top_ind(j,i,0)
784	ssurf_av(j,i) = ssurf_av(j,i) + s(k,j,i)
785	ENDDO
786	ENDDO
787	ENDIF
788
789	CASE ( 'ssws*' )
790	IF ( ALLOCATED( ssws_av ) ) THEN
791	DO i = nxl, nxr
792	DO j = nys, nyn
793	match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
794	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
795	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
796
797	IF ( match_def ) THEN
798	m = surf_def_h(0)%end_index(j,i)
799	ssws_av(j,i) = ssws_av(j,i) + surf_def_h(0)%ssws(m)
800	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
801	m = surf_lsm_h(0)%end_index(j,i)
802	ssws_av(j,i) = ssws_av(j,i) + surf_lsm_h(0)%ssws(m)
803	ELSEIF ( match_usm ) THEN
804	m = surf_usm_h(0)%end_index(j,i)
805	ssws_av(j,i) = ssws_av(j,i) + surf_usm_h(0)%ssws(m)
806	ENDIF
807	ENDDO
808	ENDDO
809	ENDIF
810
811	CASE ( 't*' )
812	IF ( ALLOCATED( ts_av ) ) THEN
813	DO i = nxl, nxr
814	DO j = nys, nyn
815	match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
816	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
817	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
818
819	IF ( match_def ) THEN
820	m = surf_def_h(0)%end_index(j,i)
821	ts_av(j,i) = ts_av(j,i) + surf_def_h(0)%ts(m)
822	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
823	m = surf_lsm_h(0)%end_index(j,i)
824	ts_av(j,i) = ts_av(j,i) + surf_lsm_h(0)%ts(m)
825	ELSEIF ( match_usm ) THEN
826	m = surf_usm_h(0)%end_index(j,i)
827	ts_av(j,i) = ts_av(j,i) + surf_usm_h(0)%ts(m)
828	ENDIF
829	ENDDO
830	ENDDO
831	ENDIF
832
833	CASE ( 'tsurf*' )
834	IF ( ALLOCATED( tsurf_av ) ) THEN
835	DO i = nxl, nxr
836	DO j = nys, nyn
837	match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
838	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
839	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
840
841	IF ( match_def ) THEN
842	m = surf_def_h(0)%end_index(j,i)
843	tsurf_av(j,i) = tsurf_av(j,i) + surf_def_h(0)%pt_surface(m)
844	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
845	m = surf_lsm_h(0)%end_index(j,i)
846	tsurf_av(j,i) = tsurf_av(j,i) + surf_lsm_h(0)%pt_surface(m)
847	ELSEIF ( match_usm ) THEN
848	m = surf_usm_h(0)%end_index(j,i)
849	tsurf_av(j,i) = tsurf_av(j,i) + surf_usm_h(0)%pt_surface(m)
850	ENDIF
851	ENDDO
852	ENDDO
853	ENDIF
854
855	CASE ( 'u' )
856	IF ( ALLOCATED( u_av ) ) THEN
857	DO i = nxlg, nxrg
858	DO j = nysg, nyng
859	DO k = nzb, nzt+1
860	u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
861	ENDDO
862	ENDDO
863	ENDDO
864	ENDIF
865
866	CASE ( 'us*' )
867	IF ( ALLOCATED( us_av ) ) THEN
868	DO i = nxl, nxr
869	DO j = nys, nyn
870	match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
871	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
872	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
873
874	IF ( match_def ) THEN
875	m = surf_def_h(0)%end_index(j,i)
876	us_av(j,i) = us_av(j,i) + surf_def_h(0)%us(m)
877	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
878	m = surf_lsm_h(0)%end_index(j,i)
879	us_av(j,i) = us_av(j,i) + surf_lsm_h(0)%us(m)
880	ELSEIF ( match_usm ) THEN
881	m = surf_usm_h(0)%end_index(j,i)
882	us_av(j,i) = us_av(j,i) + surf_usm_h(0)%us(m)
883	ENDIF
884	ENDDO
885	ENDDO
886	ENDIF
887
888	CASE ( 'v' )
889	IF ( ALLOCATED( v_av ) ) THEN
890	DO i = nxlg, nxrg
891	DO j = nysg, nyng
892	DO k = nzb, nzt+1
893	v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
894	ENDDO
895	ENDDO
896	ENDDO
897	ENDIF
898
899	CASE ( 'thetav' )
900	IF ( ALLOCATED( vpt_av ) ) THEN
901	DO i = nxlg, nxrg
902	DO j = nysg, nyng
903	DO k = nzb, nzt+1
904	vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
905	ENDDO
906	ENDDO
907	ENDDO
908	ENDIF
909
910	CASE ( 'w' )
911	IF ( ALLOCATED( w_av ) ) THEN
912	DO i = nxlg, nxrg
913	DO j = nysg, nyng
914	DO k = nzb, nzt+1
915	w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
916	ENDDO
917	ENDDO
918	ENDDO
919	ENDIF
920
921	CASE ( 'z0*' )
922	IF ( ALLOCATED( z0_av ) ) THEN
923	DO i = nxl, nxr
924	DO j = nys, nyn
925	match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
926	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
927	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
928
929	IF ( match_def ) THEN
930	m = surf_def_h(0)%end_index(j,i)
931	z0_av(j,i) = z0_av(j,i) + surf_def_h(0)%z0(m)
932	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
933	m = surf_lsm_h(0)%end_index(j,i)
934	z0_av(j,i) = z0_av(j,i) + surf_lsm_h(0)%z0(m)
935	ELSEIF ( match_usm ) THEN
936	m = surf_usm_h(0)%end_index(j,i)
937	z0_av(j,i) = z0_av(j,i) + surf_usm_h(0)%z0(m)
938	ENDIF
939	ENDDO
940	ENDDO
941	ENDIF
942
943	CASE ( 'z0h*' )
944	IF ( ALLOCATED( z0h_av ) ) THEN
945	DO i = nxl, nxr
946	DO j = nys, nyn
947	match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
948	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
949	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
950
951	IF ( match_def ) THEN
952	m = surf_def_h(0)%end_index(j,i)
953	z0h_av(j,i) = z0h_av(j,i) + surf_def_h(0)%z0h(m)
954	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
955	m = surf_lsm_h(0)%end_index(j,i)
956	z0h_av(j,i) = z0h_av(j,i) + surf_lsm_h(0)%z0h(m)
957	ELSEIF ( match_usm ) THEN
958	m = surf_usm_h(0)%end_index(j,i)
959	z0h_av(j,i) = z0h_av(j,i) + surf_usm_h(0)%z0h(m)
960	ENDIF
961	ENDDO
962	ENDDO
963	ENDIF
964
965	CASE ( 'z0q*' )
966	IF ( ALLOCATED( z0q_av ) ) THEN
967	DO i = nxl, nxr
968	DO j = nys, nyn
969	match_def = surf_def_h(0)%start_index(j,i) <= surf_def_h(0)%end_index(j,i)
970	match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i)
971	match_usm = surf_usm_h(0)%start_index(j,i) <= surf_usm_h(0)%end_index(j,i)
972
973	IF ( match_def ) THEN
974	m = surf_def_h(0)%end_index(j,i)
975	z0q_av(j,i) = z0q_av(j,i) + surf_def_h(0)%z0q(m)
976	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
977	m = surf_lsm_h(0)%end_index(j,i)
978	z0q_av(j,i) = z0q_av(j,i) + surf_lsm_h(0)%z0q(m)
979	ELSEIF ( match_usm ) THEN
980	m = surf_usm_h(0)%end_index(j,i)
981	z0q_av(j,i) = z0q_av(j,i) + surf_usm_h(0)%z0q(m)
982	ENDIF
983	ENDDO
984	ENDDO
985	ENDIF
986
987	CASE DEFAULT
988
989	!-- In case of urban surface variables it should be always checked if respective arrays are
990	!-- allocated, at least in case of a restart run, as averaged usm arrays are not read from
991	!-- file at the moment.
992	IF ( urban_surface ) THEN
993	CALL usm_3d_data_averaging( 'allocate', trimvar )
994	ENDIF
995
996	!
997	!-- Summing up data from all other modules
998	CALL module_interface_3d_data_averaging( 'sum', trimvar )
999
1000
1001	END SELECT
1002
1003	ENDDO
1004
1005	CALL cpu_log( log_point(34), 'sum_up_3d_data', 'stop' )
1006
1007
1008	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 |