Home

Context Navigation

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

Last change on this file since 4454 was 4442, checked in by suehring, 5 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 38.3 KB

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