Home

Context Navigation

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

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