Home

Context Navigation

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

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