Home

Context Navigation

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

Last change on this file since 4515 was 4514, checked in by suehring, 5 years ago
Bugfix in plant-canopy model for output of averaged transpiration rate after a restart; Revise check for output for plant heating rate and rename error message number; Surface-data output: enable output of mixing ratio and passive scalar concentration at the surface; Surface-data input: Add possibility to prescribe surface sensible and latent heat fluxes via static input file
Property svn:keywords set to `Id`
File size: 40.6 KB

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