Home

Context Navigation

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

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