Home

Context Navigation

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

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