Home

Context Navigation

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

Last change on this file since 3941 was 3933, checked in by kanani, 5 years ago
Bugfixes and clean-up for output quantity theta_2m*
Property svn:keywords set to `Id`
File size: 45.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-2019 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! ------------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: sum_up_3d_data.f90 3933 2019-04-25 12:33:20Z suehring $
27	! Formatting
28	!
29	! 3773 2019-03-01 08:56:57Z maronga
30	! Added output of theta_2m*_xy_av
31	!
32	! 3761 2019-02-25 15:31:42Z raasch
33	! unused variables removed
34	!
35	! 3655 2019-01-07 16:51:22Z knoop
36	! Implementation of the PALM module interface
37	!
38	! 3597 2018-12-04 08:40:18Z maronga
39	! Added output of theta_2m
40	!
41	! 3589 2018-11-30 15:09:51Z suehring
42	! Move the control parameter "salsa" from salsa_mod to control_parameters
43	! (M. Kurppa)
44	!
45	! 3582 2018-11-29 19:16:36Z suehring
46	! dom_dwd_user, Schrempf:
47	! Remove CALLs to uv exposure model, this is now part of biometeorology_mod
48	!
49	! 3553 2018-11-22 10:30:48Z suehring
50	! variables documented
51	!
52	! 3552 2018-11-22 10:28:35Z suehring
53	! Changes related to clean-up of biometeorology (dom_dwd_user)
54	!
55	! 3467 2018-10-30 19:05:21Z suehring
56	! Implementation of a new aerosol module salsa.
57	!
58	! 3448 2018-10-29 18:14:31Z kanani
59	! Adjustment of biometeorology calls
60	!
61	! 3421 2018-10-24 18:39:32Z gronemeier
62	! Renamed output variables
63	!
64	! 3337 2018-10-12 15:17:09Z kanani
65	! (from branch resler)
66	! Add biometeorology,
67	! fix chemistry output call,
68	! move usm calls
69	!
70	! 3294 2018-10-01 02:37:10Z raasch
71	! changes concerning modularization of ocean option
72	!
73	! 3291 2018-09-28 11:33:03Z scharf
74	! corrected previous commit for 3D topography
75	!
76	! 3285 2018-09-27 17:16:52Z scharf
77	! bugfix for shf_av and qsws_av
78	!
79	! 3274 2018-09-24 15:42:55Z knoop
80	! Modularization of all bulk cloud physics code components
81	!
82	! 3241 2018-09-12 15:02:00Z raasch
83	! unused variables removed
84	!
85	! 3176 2018-07-26 17:12:48Z suehring
86	! Remove output of latent heat flux at urban-surfaces and set fill values
87	! instead
88	!
89	! 3173 2018-07-26 12:55:23Z suehring
90	! Bugfix for last commit
91	!
92	! 3170 2018-07-25 15:19:37Z suehring
93	! Revise output of surface quantities in case of overhanging structures
94	!
95	! 3151 2018-07-19 08:45:38Z raasch
96	! Remaining preprocessor directive __chem removed
97	!
98	! 3004 2018-04-27 12:33:25Z Giersch
99	! prr field added to ONLY-list, prr* case/pr* case/precipitation_rate_av
100	! removed, further allocation checks implemented
101	!
102	! 2963 2018-04-12 14:47:44Z suehring
103	! Introduce index for vegetation/wall, pavement/green-wall and water/window
104	! surfaces, for clearer access of surface fraction, albedo, emissivity, etc. .
105	!
106	! 2894 2018-03-15 09:17:58Z Giersch
107	! Changed comment
108	!
109	! 2817 2018-02-19 16:32:21Z suehring
110	! Preliminary gust module interface implemented
111	!
112	! 2798 2018-02-09 17:16:39Z suehring
113	! Consider also default-type surfaces for surface temperature output.
114	!
115	! 2797 2018-02-08 13:24:35Z suehring
116	! Enable output of ground-heat flux also at urban surfaces.
117	!
118	! 2790 2018-02-06 11:57:19Z suehring
119	! Bugfix in summation of surface sensible and latent heat flux
120	!
121	! 2766 2018-01-22 17:17:47Z kanani
122	! Removed preprocessor directive __chem
123	!
124	! 2743 2018-01-12 16:03:39Z suehring
125	! In case of natural- and urban-type surfaces output surfaces fluxes in W/m2.
126	!
127	! 2742 2018-01-12 14:59:47Z suehring
128	! Enable output of surface temperature
129	!
130	! 2735 2018-01-11 12:01:27Z suehring
131	! output of r_a moved from land-surface to consider also urban-type surfaces
132	!
133	! 2718 2018-01-02 08:49:38Z maronga
134	! Corrected "Former revisions" section
135	!
136	! 2696 2017-12-14 17:12:51Z kanani
137	! - Change in file header (GPL part)
138	! - Implementation of uv exposure model (FK)
139	! - output of diss_av, kh_av, km_av (turbulence_closure_mod) (TG)
140	! - Implementation of chemistry module (FK)
141	! - Workaround for sum-up usm arrays in case of restart runs, to avoid program
142	! crash (MS)
143	!
144	! 2292 2017-06-20 09:51:42Z schwenkel
145	! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
146	! includes two more prognostic equations for cloud drop concentration (nc)
147	! and cloud water content (qc).
148	!
149	! 2233 2017-05-30 18:08:54Z suehring
150	!
151	! 2232 2017-05-30 17:47:52Z suehring
152	! Adjustments to new surface concept
153	!
154	! 2031 2016-10-21 15:11:58Z knoop
155	! renamed variable rho to rho_ocean and rho_av to rho_ocean_av
156	!
157	! 2024 2016-10-12 16:42:37Z kanani
158	! Added missing CASE for ssws*
159	!
160	! 2011 2016-09-19 17:29:57Z kanani
161	! Flag urban_surface is now defined in module control_parameters,
162	! changed prefix for urban surface model output to "usm_",
163	! introduced control parameter varnamelength for LEN of trimvar.
164	!
165	! 2007 2016-08-24 15:47:17Z kanani
166	! Added support for new urban surface model (temporary modifications of
167	! SELECT CASE ( ) necessary, see variable trimvar),
168	! added comments in variable declaration section
169	!
170	! 2000 2016-08-20 18:09:15Z knoop
171	! Forced header and separation lines into 80 columns
172	!
173	! 1992 2016-08-12 15:14:59Z suehring
174	! Bugfix in summation of passive scalar
175	!
176	! 1976 2016-07-27 13:28:04Z maronga
177	! Radiation actions are now done directly in the respective module
178	!
179	! 1972 2016-07-26 07:52:02Z maronga
180	! Land surface actions are now done directly in the respective module
181	!
182	! 1960 2016-07-12 16:34:24Z suehring
183	! Scalar surface flux added
184	!
185	! 1949 2016-06-17 07:19:16Z maronga
186	! Bugfix: calculation of lai_av, c_veg_av and c_liq_av.
187	!
188	! 1849 2016-04-08 11:33:18Z hoffmann
189	! precipitation_rate moved to arrays_3d
190	!
191	! 1788 2016-03-10 11:01:04Z maronga
192	! Added z0q and z0q_av
193	!
194	! 1693 2015-10-27 08:35:45Z maronga
195	! Last revision text corrected
196	!
197	! 1691 2015-10-26 16:17:44Z maronga
198	! Added output of Obukhov length and radiative heating rates for RRTMG.
199	! Corrected output of liquid water path.
200	!
201	! 1682 2015-10-07 23:56:08Z knoop
202	! Code annotations made doxygen readable
203	!
204	! 1585 2015-04-30 07:05:52Z maronga
205	! Adapted for RRTMG
206	!
207	! 1555 2015-03-04 17:44:27Z maronga
208	! Added output of r_a and r_s
209	!
210	! 1551 2015-03-03 14:18:16Z maronga
211	! Added support for land surface model and radiation model data.
212	!
213	! 1359 2014-04-11 17:15:14Z hoffmann
214	! New particle structure integrated.
215	!
216	! 1353 2014-04-08 15:21:23Z heinze
217	! REAL constants provided with KIND-attribute
218	!
219	! 1320 2014-03-20 08:40:49Z raasch
220	! ONLY-attribute added to USE-statements,
221	! kind-parameters added to all INTEGER and REAL declaration statements,
222	! kinds are defined in new module kinds,
223	! old module precision_kind is removed,
224	! revision history before 2012 removed,
225	! comment fields (!:) to be used for variable explanations added to
226	! all variable declaration statements
227	!
228	! 1318 2014-03-17 13:35:16Z raasch
229	! barrier argument removed from cpu_log,
230	! module interfaces removed
231	!
232	! 1115 2013-03-26 18:16:16Z hoffmann
233	! ql is calculated by calc_liquid_water_content
234	!
235	! 1053 2012-11-13 17:11:03Z hoffmann
236	! +nr, prr, qr
237	!
238	! 1036 2012-10-22 13:43:42Z raasch
239	! code put under GPL (PALM 3.9)
240	!
241	! 1007 2012-09-19 14:30:36Z franke
242	! Bugfix in calculation of ql_vp
243	!
244	! 978 2012-08-09 08:28:32Z fricke
245	! +z0h*
246	!
247	! Revision 1.1 2006/02/23 12:55:23 raasch
248	! Initial revision
249	!
250	!
251	! Description:
252	! ------------
253	!> Sum-up the values of 3d-arrays. The real averaging is later done in routine
254	!> average_3d_data.
255	!------------------------------------------------------------------------------!
256	SUBROUTINE sum_up_3d_data
257
258
259	USE arrays_3d, &
260	ONLY: dzw, d_exner, e, heatflux_output_conversion, p, &
261	pt, q, ql, ql_c, ql_v, s, u, v, vpt, w, &
262	waterflux_output_conversion
263
264	USE averaging, &
265	ONLY: e_av, ghf_av, lpt_av, lwp_av, ol_av, p_av, pc_av, pr_av, pt_av, &
266	pt_2m_av, q_av, ql_av, ql_c_av, ql_v_av, ql_vp_av, qsws_av, &
267	qv_av, r_a_av, s_av, shf_av, ssws_av, ts_av, tsurf_av, u_av, &
268	us_av, v_av, vpt_av, w_av, z0_av, z0h_av, z0q_av
269
270	USE basic_constants_and_equations_mod, &
271	ONLY: c_p, lv_d_cp, l_v
272
273	USE bulk_cloud_model_mod, &
274	ONLY: bulk_cloud_model
275
276	USE control_parameters, &
277	ONLY: average_count_3d, doav, doav_n, rho_surface, urban_surface, &
278	varnamelength
279
280	USE cpulog, &
281	ONLY: cpu_log, log_point
282
283	USE indices, &
284	ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
285
286	USE kinds
287
288	USE module_interface, &
289	ONLY: module_interface_3d_data_averaging
290
291	USE particle_attributes, &
292	ONLY: grid_particles, number_of_particles, particles, prt_count
293
294	USE surface_mod, &
295	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, &
296	surf_def_h, surf_lsm_h, surf_usm_h
297
298	USE turbulence_closure_mod, &
299	ONLY: tcm_3d_data_averaging
300
301	USE urban_surface_mod, &
302	ONLY: usm_3d_data_averaging
303
304
305	IMPLICIT NONE
306
307	LOGICAL :: match_def !< flag indicating default-type surface
308	LOGICAL :: match_lsm !< flag indicating natural-type surface
309	LOGICAL :: match_usm !< flag indicating urban-type surface
310
311	INTEGER(iwp) :: i !< grid index x direction
312	INTEGER(iwp) :: ii !< running index
313	INTEGER(iwp) :: j !< grid index y direction
314	INTEGER(iwp) :: k !< grid index x direction
315	INTEGER(iwp) :: m !< running index over surfacle elements
316	INTEGER(iwp) :: n !< running index over number of particles per grid box
317
318	REAL(wp) :: mean_r !< mean-particle radius witin grid box
319	REAL(wp) :: s_r2 !< mean-particle radius witin grid box to the power of two
320	REAL(wp) :: s_r3 !< mean-particle radius witin grid box to the power of three
321
322	CHARACTER (LEN=varnamelength) :: trimvar !< TRIM of output-variable string
323
324
325	CALL cpu_log (log_point(34),'sum_up_3d_data','start')
326
327	!
328	!-- Allocate and initialize the summation arrays if called for the very first
329	!-- time or the first time after average_3d_data has been called
330	!-- (some or all of the arrays may have been already allocated
331	!-- in rrd_local)
332	IF ( average_count_3d == 0 ) THEN
333
334	DO ii = 1, doav_n
335
336	trimvar = TRIM( doav(ii) )
337
338	SELECT CASE ( trimvar )
339
340	CASE ( 'ghf*' )
341	IF ( .NOT. ALLOCATED( ghf_av ) ) THEN
342	ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
343	ENDIF
344	ghf_av = 0.0_wp
345
346	CASE ( 'e' )
347	IF ( .NOT. ALLOCATED( e_av ) ) THEN
348	ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
349	ENDIF
350	e_av = 0.0_wp
351
352	CASE ( 'thetal' )
353	IF ( .NOT. ALLOCATED( lpt_av ) ) THEN
354	ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
355	ENDIF
356	lpt_av = 0.0_wp
357
358	CASE ( 'lwp*' )
359	IF ( .NOT. ALLOCATED( lwp_av ) ) THEN
360	ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
361	ENDIF
362	lwp_av = 0.0_wp
363
364	CASE ( 'ol*' )
365	IF ( .NOT. ALLOCATED( ol_av ) ) THEN
366	ALLOCATE( ol_av(nysg:nyng,nxlg:nxrg) )
367	ENDIF
368	ol_av = 0.0_wp
369
370	CASE ( 'p' )
371	IF ( .NOT. ALLOCATED( p_av ) ) THEN
372	ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
373	ENDIF
374	p_av = 0.0_wp
375
376	CASE ( 'pc' )
377	IF ( .NOT. ALLOCATED( pc_av ) ) THEN
378	ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
379	ENDIF
380	pc_av = 0.0_wp
381
382	CASE ( 'pr' )
383	IF ( .NOT. ALLOCATED( pr_av ) ) THEN
384	ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
385	ENDIF
386	pr_av = 0.0_wp
387
388	CASE ( 'theta' )
389	IF ( .NOT. ALLOCATED( pt_av ) ) THEN
390	ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
391	ENDIF
392	pt_av = 0.0_wp
393
394	CASE ( 'q' )
395	IF ( .NOT. ALLOCATED( q_av ) ) THEN
396	ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
397	ENDIF
398	q_av = 0.0_wp
399
400	CASE ( 'ql' )
401	IF ( .NOT. ALLOCATED( ql_av ) ) THEN
402	ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
403	ENDIF
404	ql_av = 0.0_wp
405
406	CASE ( 'ql_c' )
407	IF ( .NOT. ALLOCATED( ql_c_av ) ) THEN
408	ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
409	ENDIF
410	ql_c_av = 0.0_wp
411
412	CASE ( 'ql_v' )
413	IF ( .NOT. ALLOCATED( ql_v_av ) ) THEN
414	ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
415	ENDIF
416	ql_v_av = 0.0_wp
417
418	CASE ( 'ql_vp' )
419	IF ( .NOT. ALLOCATED( ql_vp_av ) ) THEN
420	ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
421	ENDIF
422	ql_vp_av = 0.0_wp
423
424	CASE ( 'qsws*' )
425	IF ( .NOT. ALLOCATED( qsws_av ) ) THEN
426	ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
427	ENDIF
428	qsws_av = 0.0_wp
429
430	CASE ( 'qv' )
431	IF ( .NOT. ALLOCATED( qv_av ) ) THEN
432	ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
433	ENDIF
434	qv_av = 0.0_wp
435
436	CASE ( 'r_a*' )
437	IF ( .NOT. ALLOCATED( r_a_av ) ) THEN
438	ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
439	ENDIF
440	r_a_av = 0.0_wp
441
442	CASE ( 's' )
443	IF ( .NOT. ALLOCATED( s_av ) ) THEN
444	ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
445	ENDIF
446	s_av = 0.0_wp
447
448	CASE ( 'shf*' )
449	IF ( .NOT. ALLOCATED( shf_av ) ) THEN
450	ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
451	ENDIF
452	shf_av = 0.0_wp
453
454	CASE ( 'ssws*' )
455	IF ( .NOT. ALLOCATED( ssws_av ) ) THEN
456	ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
457	ENDIF
458	ssws_av = 0.0_wp
459
460	CASE ( 't*' )
461	IF ( .NOT. ALLOCATED( ts_av ) ) THEN
462	ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
463	ENDIF
464	ts_av = 0.0_wp
465
466	CASE ( 'tsurf*' )
467	IF ( .NOT. ALLOCATED( tsurf_av ) ) THEN
468	ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
469	ENDIF
470	tsurf_av = 0.0_wp
471
472	CASE ( 'u' )
473	IF ( .NOT. ALLOCATED( u_av ) ) THEN
474	ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
475	ENDIF
476	u_av = 0.0_wp
477
478	CASE ( 'us*' )
479	IF ( .NOT. ALLOCATED( us_av ) ) THEN
480	ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
481	ENDIF
482	us_av = 0.0_wp
483
484	CASE ( 'v' )
485	IF ( .NOT. ALLOCATED( v_av ) ) THEN
486	ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
487	ENDIF
488	v_av = 0.0_wp
489
490	CASE ( 'thetav' )
491	IF ( .NOT. ALLOCATED( vpt_av ) ) THEN
492	ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
493	ENDIF
494	vpt_av = 0.0_wp
495
496	CASE ( 'theta_2m*' )
497	IF ( .NOT. ALLOCATED( pt_2m_av ) ) THEN
498	ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
499	ENDIF
500	pt_2m_av = 0.0_wp
501
502	CASE ( 'w' )
503	IF ( .NOT. ALLOCATED( w_av ) ) THEN
504	ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
505	ENDIF
506	w_av = 0.0_wp
507
508	CASE ( 'z0*' )
509	IF ( .NOT. ALLOCATED( z0_av ) ) THEN
510	ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
511	ENDIF
512	z0_av = 0.0_wp
513
514	CASE ( 'z0h*' )
515	IF ( .NOT. ALLOCATED( z0h_av ) ) THEN
516	ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
517	ENDIF
518	z0h_av = 0.0_wp
519
520	CASE ( 'z0q*' )
521	IF ( .NOT. ALLOCATED( z0q_av ) ) THEN
522	ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
523	ENDIF
524	z0q_av = 0.0_wp
525
526
527	CASE DEFAULT
528
529	!
530	!-- Allocating and initializing data arrays for turbulence closure module
531	CALL tcm_3d_data_averaging( 'allocate', trimvar )
532
533	!
534	!-- Allocating and initializing data arrays for all other modules
535	CALL module_interface_3d_data_averaging( 'allocate', trimvar )
536
537
538	END SELECT
539
540	ENDDO
541
542	ENDIF
543
544	!
545	!-- Loop of all variables to be averaged.
546	DO ii = 1, doav_n
547
548	trimvar = TRIM( doav(ii) )
549	!
550	!-- Store the array chosen on the temporary array.
551	SELECT CASE ( trimvar )
552
553	CASE ( 'ghf*' )
554	IF ( ALLOCATED( ghf_av ) ) THEN
555	DO i = nxl, nxr
556	DO j = nys, nyn
557	!
558	!-- Check whether grid point is a natural- or urban-type
559	!-- surface.
560	match_lsm = surf_lsm_h%start_index(j,i) <= &
561	surf_lsm_h%end_index(j,i)
562	match_usm = surf_usm_h%start_index(j,i) <= &
563	surf_usm_h%end_index(j,i)
564	!
565	!-- In order to avoid double-counting of surface properties,
566	!-- always assume that natural-type surfaces are below urban-
567	!-- type surfaces, e.g. in case of bridges.
568	!-- Further, take only the last suface element, i.e. the
569	!-- uppermost surface which would be visible from above
570	IF ( match_lsm .AND. .NOT. match_usm ) THEN
571	m = surf_lsm_h%end_index(j,i)
572	ghf_av(j,i) = ghf_av(j,i) + &
573	surf_lsm_h%ghf(m)
574	ELSEIF ( match_usm ) THEN
575	m = surf_usm_h%end_index(j,i)
576	ghf_av(j,i) = ghf_av(j,i) + &
577	surf_usm_h%frac(ind_veg_wall,m) * &
578	surf_usm_h%wghf_eb(m) + &
579	surf_usm_h%frac(ind_pav_green,m) * &
580	surf_usm_h%wghf_eb_green(m) + &
581	surf_usm_h%frac(ind_wat_win,m) * &
582	surf_usm_h%wghf_eb_window(m)
583	ENDIF
584	ENDDO
585	ENDDO
586	ENDIF
587
588	CASE ( 'e' )
589	IF ( ALLOCATED( e_av ) ) THEN
590	DO i = nxlg, nxrg
591	DO j = nysg, nyng
592	DO k = nzb, nzt+1
593	e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
594	ENDDO
595	ENDDO
596	ENDDO
597	ENDIF
598
599	CASE ( 'thetal' )
600	IF ( ALLOCATED( lpt_av ) ) THEN
601	DO i = nxlg, nxrg
602	DO j = nysg, nyng
603	DO k = nzb, nzt+1
604	lpt_av(k,j,i) = lpt_av(k,j,i) + pt(k,j,i)
605	ENDDO
606	ENDDO
607	ENDDO
608	ENDIF
609
610	CASE ( 'lwp*' )
611	IF ( ALLOCATED( lwp_av ) ) THEN
612	DO i = nxlg, nxrg
613	DO j = nysg, nyng
614	lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) &
615	* dzw(1:nzt+1) ) * rho_surface
616	ENDDO
617	ENDDO
618	ENDIF
619
620	CASE ( 'ol*' )
621	IF ( ALLOCATED( ol_av ) ) THEN
622	DO i = nxl, nxr
623	DO j = nys, nyn
624	match_def = surf_def_h(0)%start_index(j,i) <= &
625	surf_def_h(0)%end_index(j,i)
626	match_lsm = surf_lsm_h%start_index(j,i) <= &
627	surf_lsm_h%end_index(j,i)
628	match_usm = surf_usm_h%start_index(j,i) <= &
629	surf_usm_h%end_index(j,i)
630
631	IF ( match_def ) THEN
632	m = surf_def_h(0)%end_index(j,i)
633	ol_av(j,i) = ol_av(j,i) + &
634	surf_def_h(0)%ol(m)
635	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
636	m = surf_lsm_h%end_index(j,i)
637	ol_av(j,i) = ol_av(j,i) + &
638	surf_lsm_h%ol(m)
639	ELSEIF ( match_usm ) THEN
640	m = surf_usm_h%end_index(j,i)
641	ol_av(j,i) = ol_av(j,i) + &
642	surf_usm_h%ol(m)
643	ENDIF
644	ENDDO
645	ENDDO
646	ENDIF
647
648	CASE ( 'p' )
649	IF ( ALLOCATED( p_av ) ) THEN
650	DO i = nxlg, nxrg
651	DO j = nysg, nyng
652	DO k = nzb, nzt+1
653	p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
654	ENDDO
655	ENDDO
656	ENDDO
657	ENDIF
658
659	CASE ( 'pc' )
660	IF ( ALLOCATED( pc_av ) ) THEN
661	DO i = nxl, nxr
662	DO j = nys, nyn
663	DO k = nzb, nzt+1
664	pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
665	ENDDO
666	ENDDO
667	ENDDO
668	ENDIF
669
670	CASE ( 'pr' )
671	IF ( ALLOCATED( pr_av ) ) THEN
672	DO i = nxl, nxr
673	DO j = nys, nyn
674	DO k = nzb, nzt+1
675	number_of_particles = prt_count(k,j,i)
676	IF ( number_of_particles <= 0 ) CYCLE
677	particles => &
678	grid_particles(k,j,i)%particles(1:number_of_particles)
679	s_r2 = 0.0_wp
680	s_r3 = 0.0_wp
681
682	DO n = 1, number_of_particles
683	IF ( particles(n)%particle_mask ) THEN
684	s_r2 = s_r2 + particles(n)%radius*2 &
685	particles(n)%weight_factor
686	s_r3 = s_r3 + particles(n)%radius*3 &
687	particles(n)%weight_factor
688	ENDIF
689	ENDDO
690
691	IF ( s_r2 > 0.0_wp ) THEN
692	mean_r = s_r3 / s_r2
693	ELSE
694	mean_r = 0.0_wp
695	ENDIF
696	pr_av(k,j,i) = pr_av(k,j,i) + mean_r
697	ENDDO
698	ENDDO
699	ENDDO
700	ENDIF
701
702	CASE ( 'theta' )
703	IF ( ALLOCATED( pt_av ) ) THEN
704	IF ( .NOT. bulk_cloud_model ) THEN
705	DO i = nxlg, nxrg
706	DO j = nysg, nyng
707	DO k = nzb, nzt+1
708	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
709	ENDDO
710	ENDDO
711	ENDDO
712	ELSE
713	DO i = nxlg, nxrg
714	DO j = nysg, nyng
715	DO k = nzb, nzt+1
716	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + lv_d_cp * &
717	d_exner(k) * ql(k,j,i)
718	ENDDO
719	ENDDO
720	ENDDO
721	ENDIF
722	ENDIF
723
724	CASE ( 'q' )
725	IF ( ALLOCATED( q_av ) ) THEN
726	DO i = nxlg, nxrg
727	DO j = nysg, nyng
728	DO k = nzb, nzt+1
729	q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
730	ENDDO
731	ENDDO
732	ENDDO
733	ENDIF
734
735	CASE ( 'ql' )
736	IF ( ALLOCATED( ql_av ) ) THEN
737	DO i = nxlg, nxrg
738	DO j = nysg, nyng
739	DO k = nzb, nzt+1
740	ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
741	ENDDO
742	ENDDO
743	ENDDO
744	ENDIF
745
746	CASE ( 'ql_c' )
747	IF ( ALLOCATED( ql_c_av ) ) THEN
748	DO i = nxlg, nxrg
749	DO j = nysg, nyng
750	DO k = nzb, nzt+1
751	ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
752	ENDDO
753	ENDDO
754	ENDDO
755	ENDIF
756
757	CASE ( 'ql_v' )
758	IF ( ALLOCATED( ql_v_av ) ) THEN
759	DO i = nxlg, nxrg
760	DO j = nysg, nyng
761	DO k = nzb, nzt+1
762	ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
763	ENDDO
764	ENDDO
765	ENDDO
766	ENDIF
767
768	CASE ( 'ql_vp' )
769	IF ( ALLOCATED( ql_vp_av ) ) THEN
770	DO i = nxl, nxr
771	DO j = nys, nyn
772	DO k = nzb, nzt+1
773	number_of_particles = prt_count(k,j,i)
774	IF ( number_of_particles <= 0 ) CYCLE
775	particles => &
776	grid_particles(k,j,i)%particles(1:number_of_particles)
777	DO n = 1, number_of_particles
778	IF ( particles(n)%particle_mask ) THEN
779	ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + &
780	particles(n)%weight_factor / &
781	number_of_particles
782	ENDIF
783	ENDDO
784	ENDDO
785	ENDDO
786	ENDDO
787	ENDIF
788
789	CASE ( 'qsws*' )
790	!
791	!-- In case of default surfaces, clean-up flux by density.
792	!-- In case of land- and urban-surfaces, convert fluxes into
793	!-- dynamic units.
794	IF ( ALLOCATED( qsws_av ) ) THEN
795	DO i = nxl, nxr
796	DO j = nys, nyn
797	match_def = surf_def_h(0)%start_index(j,i) <= &
798	surf_def_h(0)%end_index(j,i)
799	match_lsm = surf_lsm_h%start_index(j,i) <= &
800	surf_lsm_h%end_index(j,i)
801	match_usm = surf_usm_h%start_index(j,i) <= &
802	surf_usm_h%end_index(j,i)
803
804	IF ( match_def ) THEN
805	m = surf_def_h(0)%end_index(j,i)
806	qsws_av(j,i) = qsws_av(j,i) + &
807	surf_def_h(0)%qsws(m) * &
808	waterflux_output_conversion(nzb)
809	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
810	m = surf_lsm_h%end_index(j,i)
811	qsws_av(j,i) = qsws_av(j,i) + &
812	surf_lsm_h%qsws(m) * l_v
813	ENDIF
814	ENDDO
815	ENDDO
816	ENDIF
817
818	CASE ( 'qv' )
819	IF ( ALLOCATED( qv_av ) ) THEN
820	DO i = nxlg, nxrg
821	DO j = nysg, nyng
822	DO k = nzb, nzt+1
823	qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
824	ENDDO
825	ENDDO
826	ENDDO
827	ENDIF
828
829	CASE ( 'r_a*' )
830	IF ( ALLOCATED( r_a_av ) ) THEN
831	DO i = nxl, nxr
832	DO j = nys, nyn
833	match_lsm = surf_lsm_h%start_index(j,i) <= &
834	surf_lsm_h%end_index(j,i)
835	match_usm = surf_usm_h%start_index(j,i) <= &
836	surf_usm_h%end_index(j,i)
837
838	IF ( match_lsm .AND. .NOT. match_usm ) THEN
839	m = surf_lsm_h%end_index(j,i)
840	r_a_av(j,i) = r_a_av(j,i) + &
841	surf_lsm_h%r_a(m)
842	ELSEIF ( match_usm ) THEN
843	m = surf_usm_h%end_index(j,i)
844	r_a_av(j,i) = r_a_av(j,i) + &
845	surf_usm_h%frac(ind_veg_wall,m) * &
846	surf_usm_h%r_a(m) + &
847	surf_usm_h%frac(ind_pav_green,m) * &
848	surf_usm_h%r_a_green(m) + &
849	surf_usm_h%frac(ind_wat_win,m) * &
850	surf_usm_h%r_a_window(m)
851	ENDIF
852	ENDDO
853	ENDDO
854	ENDIF
855
856	CASE ( 's' )
857	IF ( ALLOCATED( s_av ) ) THEN
858	DO i = nxlg, nxrg
859	DO j = nysg, nyng
860	DO k = nzb, nzt+1
861	s_av(k,j,i) = s_av(k,j,i) + s(k,j,i)
862	ENDDO
863	ENDDO
864	ENDDO
865	ENDIF
866
867	CASE ( 'shf*' )
868	!
869	!-- In case of default surfaces, clean-up flux by density.
870	!-- In case of land- and urban-surfaces, convert fluxes into
871	!-- dynamic units.
872	IF ( ALLOCATED( shf_av ) ) THEN
873	DO i = nxl, nxr
874	DO j = nys, nyn
875	match_def = surf_def_h(0)%start_index(j,i) <= &
876	surf_def_h(0)%end_index(j,i)
877	match_lsm = surf_lsm_h%start_index(j,i) <= &
878	surf_lsm_h%end_index(j,i)
879	match_usm = surf_usm_h%start_index(j,i) <= &
880	surf_usm_h%end_index(j,i)
881
882	IF ( match_def ) THEN
883	m = surf_def_h(0)%end_index(j,i)
884	shf_av(j,i) = shf_av(j,i) + &
885	surf_def_h(0)%shf(m) * &
886	heatflux_output_conversion(nzb)
887	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
888	m = surf_lsm_h%end_index(j,i)
889	shf_av(j,i) = shf_av(j,i) + &
890	surf_lsm_h%shf(m) * c_p
891	ELSEIF ( match_usm ) THEN
892	m = surf_usm_h%end_index(j,i)
893	shf_av(j,i) = shf_av(j,i) + &
894	surf_usm_h%shf(m) * c_p
895	ENDIF
896	ENDDO
897	ENDDO
898	ENDIF
899
900	CASE ( 'ssws*' )
901	IF ( ALLOCATED( ssws_av ) ) THEN
902	DO i = nxl, nxr
903	DO j = nys, nyn
904	match_def = surf_def_h(0)%start_index(j,i) <= &
905	surf_def_h(0)%end_index(j,i)
906	match_lsm = surf_lsm_h%start_index(j,i) <= &
907	surf_lsm_h%end_index(j,i)
908	match_usm = surf_usm_h%start_index(j,i) <= &
909	surf_usm_h%end_index(j,i)
910
911	IF ( match_def ) THEN
912	m = surf_def_h(0)%end_index(j,i)
913	ssws_av(j,i) = ssws_av(j,i) + &
914	surf_def_h(0)%ssws(m)
915	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
916	m = surf_lsm_h%end_index(j,i)
917	ssws_av(j,i) = ssws_av(j,i) + &
918	surf_lsm_h%ssws(m)
919	ELSEIF ( match_usm ) THEN
920	m = surf_usm_h%end_index(j,i)
921	ssws_av(j,i) = ssws_av(j,i) + &
922	surf_usm_h%ssws(m)
923	ENDIF
924	ENDDO
925	ENDDO
926	ENDIF
927
928	CASE ( 'theta_2m*' )
929	IF ( ALLOCATED( pt_2m_av ) ) THEN
930	DO i = nxl, nxr
931	DO j = nys, nyn
932	match_def = surf_def_h(0)%start_index(j,i) <= &
933	surf_def_h(0)%end_index(j,i)
934	match_lsm = surf_lsm_h%start_index(j,i) <= &
935	surf_lsm_h%end_index(j,i)
936	match_usm = surf_usm_h%start_index(j,i) <= &
937	surf_usm_h%end_index(j,i)
938
939	IF ( match_def ) THEN
940	m = surf_def_h(0)%end_index(j,i)
941	pt_2m_av(j,i) = pt_2m_av(j,i) + &
942	surf_def_h(0)%pt_2m(m)
943	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
944	m = surf_lsm_h%end_index(j,i)
945	pt_2m_av(j,i) = pt_2m_av(j,i) + &
946	surf_lsm_h%pt_2m(m)
947	ELSEIF ( match_usm ) THEN
948	m = surf_usm_h%end_index(j,i)
949	pt_2m_av(j,i) = pt_2m_av(j,i) + &
950	surf_usm_h%pt_2m(m)
951	ENDIF
952	ENDDO
953	ENDDO
954	ENDIF
955
956
957	CASE ( 't*' )
958	IF ( ALLOCATED( ts_av ) ) THEN
959	DO i = nxl, nxr
960	DO j = nys, nyn
961	match_def = surf_def_h(0)%start_index(j,i) <= &
962	surf_def_h(0)%end_index(j,i)
963	match_lsm = surf_lsm_h%start_index(j,i) <= &
964	surf_lsm_h%end_index(j,i)
965	match_usm = surf_usm_h%start_index(j,i) <= &
966	surf_usm_h%end_index(j,i)
967
968	IF ( match_def ) THEN
969	m = surf_def_h(0)%end_index(j,i)
970	ts_av(j,i) = ts_av(j,i) + &
971	surf_def_h(0)%ts(m)
972	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
973	m = surf_lsm_h%end_index(j,i)
974	ts_av(j,i) = ts_av(j,i) + &
975	surf_lsm_h%ts(m)
976	ELSEIF ( match_usm ) THEN
977	m = surf_usm_h%end_index(j,i)
978	ts_av(j,i) = ts_av(j,i) + &
979	surf_usm_h%ts(m)
980	ENDIF
981	ENDDO
982	ENDDO
983	ENDIF
984
985	CASE ( 'tsurf*' )
986	IF ( ALLOCATED( tsurf_av ) ) THEN
987	DO i = nxl, nxr
988	DO j = nys, nyn
989	match_def = surf_def_h(0)%start_index(j,i) <= &
990	surf_def_h(0)%end_index(j,i)
991	match_lsm = surf_lsm_h%start_index(j,i) <= &
992	surf_lsm_h%end_index(j,i)
993	match_usm = surf_usm_h%start_index(j,i) <= &
994	surf_usm_h%end_index(j,i)
995
996	IF ( match_def ) THEN
997	m = surf_def_h(0)%end_index(j,i)
998	tsurf_av(j,i) = tsurf_av(j,i) + &
999	surf_def_h(0)%pt_surface(m)
1000	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
1001	m = surf_lsm_h%end_index(j,i)
1002	tsurf_av(j,i) = tsurf_av(j,i) + &
1003	surf_lsm_h%pt_surface(m)
1004	ELSEIF ( match_usm ) THEN
1005	m = surf_usm_h%end_index(j,i)
1006	tsurf_av(j,i) = tsurf_av(j,i) + &
1007	surf_usm_h%pt_surface(m)
1008	ENDIF
1009	ENDDO
1010	ENDDO
1011	ENDIF
1012
1013	CASE ( 'u' )
1014	IF ( ALLOCATED( u_av ) ) THEN
1015	DO i = nxlg, nxrg
1016	DO j = nysg, nyng
1017	DO k = nzb, nzt+1
1018	u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
1019	ENDDO
1020	ENDDO
1021	ENDDO
1022	ENDIF
1023
1024	CASE ( 'us*' )
1025	IF ( ALLOCATED( us_av ) ) THEN
1026	DO i = nxl, nxr
1027	DO j = nys, nyn
1028	match_def = surf_def_h(0)%start_index(j,i) <= &
1029	surf_def_h(0)%end_index(j,i)
1030	match_lsm = surf_lsm_h%start_index(j,i) <= &
1031	surf_lsm_h%end_index(j,i)
1032	match_usm = surf_usm_h%start_index(j,i) <= &
1033	surf_usm_h%end_index(j,i)
1034
1035	IF ( match_def ) THEN
1036	m = surf_def_h(0)%end_index(j,i)
1037	us_av(j,i) = us_av(j,i) + &
1038	surf_def_h(0)%us(m)
1039	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
1040	m = surf_lsm_h%end_index(j,i)
1041	us_av(j,i) = us_av(j,i) + &
1042	surf_lsm_h%us(m)
1043	ELSEIF ( match_usm ) THEN
1044	m = surf_usm_h%end_index(j,i)
1045	us_av(j,i) = us_av(j,i) + &
1046	surf_usm_h%us(m)
1047	ENDIF
1048	ENDDO
1049	ENDDO
1050	ENDIF
1051
1052	CASE ( 'v' )
1053	IF ( ALLOCATED( v_av ) ) THEN
1054	DO i = nxlg, nxrg
1055	DO j = nysg, nyng
1056	DO k = nzb, nzt+1
1057	v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
1058	ENDDO
1059	ENDDO
1060	ENDDO
1061	ENDIF
1062
1063	CASE ( 'thetav' )
1064	IF ( ALLOCATED( vpt_av ) ) THEN
1065	DO i = nxlg, nxrg
1066	DO j = nysg, nyng
1067	DO k = nzb, nzt+1
1068	vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
1069	ENDDO
1070	ENDDO
1071	ENDDO
1072	ENDIF
1073
1074	CASE ( 'w' )
1075	IF ( ALLOCATED( w_av ) ) THEN
1076	DO i = nxlg, nxrg
1077	DO j = nysg, nyng
1078	DO k = nzb, nzt+1
1079	w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
1080	ENDDO
1081	ENDDO
1082	ENDDO
1083	ENDIF
1084
1085	CASE ( 'z0*' )
1086	IF ( ALLOCATED( z0_av ) ) THEN
1087	DO i = nxl, nxr
1088	DO j = nys, nyn
1089	match_def = surf_def_h(0)%start_index(j,i) <= &
1090	surf_def_h(0)%end_index(j,i)
1091	match_lsm = surf_lsm_h%start_index(j,i) <= &
1092	surf_lsm_h%end_index(j,i)
1093	match_usm = surf_usm_h%start_index(j,i) <= &
1094	surf_usm_h%end_index(j,i)
1095
1096	IF ( match_def ) THEN
1097	m = surf_def_h(0)%end_index(j,i)
1098	z0_av(j,i) = z0_av(j,i) + &
1099	surf_def_h(0)%z0(m)
1100	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
1101	m = surf_lsm_h%end_index(j,i)
1102	z0_av(j,i) = z0_av(j,i) + &
1103	surf_lsm_h%z0(m)
1104	ELSEIF ( match_usm ) THEN
1105	m = surf_usm_h%end_index(j,i)
1106	z0_av(j,i) = z0_av(j,i) + &
1107	surf_usm_h%z0(m)
1108	ENDIF
1109	ENDDO
1110	ENDDO
1111	ENDIF
1112
1113	CASE ( 'z0h*' )
1114	IF ( ALLOCATED( z0h_av ) ) THEN
1115	DO i = nxl, nxr
1116	DO j = nys, nyn
1117	match_def = surf_def_h(0)%start_index(j,i) <= &
1118	surf_def_h(0)%end_index(j,i)
1119	match_lsm = surf_lsm_h%start_index(j,i) <= &
1120	surf_lsm_h%end_index(j,i)
1121	match_usm = surf_usm_h%start_index(j,i) <= &
1122	surf_usm_h%end_index(j,i)
1123
1124	IF ( match_def ) THEN
1125	m = surf_def_h(0)%end_index(j,i)
1126	z0h_av(j,i) = z0h_av(j,i) + &
1127	surf_def_h(0)%z0h(m)
1128	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
1129	m = surf_lsm_h%end_index(j,i)
1130	z0h_av(j,i) = z0h_av(j,i) + &
1131	surf_lsm_h%z0h(m)
1132	ELSEIF ( match_usm ) THEN
1133	m = surf_usm_h%end_index(j,i)
1134	z0h_av(j,i) = z0h_av(j,i) + &
1135	surf_usm_h%z0h(m)
1136	ENDIF
1137	ENDDO
1138	ENDDO
1139	ENDIF
1140
1141	CASE ( 'z0q*' )
1142	IF ( ALLOCATED( z0q_av ) ) THEN
1143	DO i = nxl, nxr
1144	DO j = nys, nyn
1145	match_def = surf_def_h(0)%start_index(j,i) <= &
1146	surf_def_h(0)%end_index(j,i)
1147	match_lsm = surf_lsm_h%start_index(j,i) <= &
1148	surf_lsm_h%end_index(j,i)
1149	match_usm = surf_usm_h%start_index(j,i) <= &
1150	surf_usm_h%end_index(j,i)
1151
1152	IF ( match_def ) THEN
1153	m = surf_def_h(0)%end_index(j,i)
1154	z0q_av(j,i) = z0q_av(j,i) + &
1155	surf_def_h(0)%z0q(m)
1156	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
1157	m = surf_lsm_h%end_index(j,i)
1158	z0q_av(j,i) = z0q_av(j,i) + &
1159	surf_lsm_h%z0q(m)
1160	ELSEIF ( match_usm ) THEN
1161	m = surf_usm_h%end_index(j,i)
1162	z0q_av(j,i) = z0q_av(j,i) + &
1163	surf_usm_h%z0q(m)
1164	ENDIF
1165	ENDDO
1166	ENDDO
1167	ENDIF
1168
1169	CASE DEFAULT
1170
1171	!-- In case of urban surface variables it should be always checked
1172	!-- if respective arrays are allocated, at least in case of a restart
1173	!-- run, as averaged usm arrays are not read from file at the moment.
1174	IF ( urban_surface ) THEN
1175	CALL usm_3d_data_averaging( 'allocate', trimvar )
1176	ENDIF
1177
1178	!
1179	!-- Summing up data from turbulence closure module
1180	CALL tcm_3d_data_averaging( 'sum', trimvar )
1181
1182	!
1183	!-- Summing up data from all other modules
1184	CALL module_interface_3d_data_averaging( 'sum', trimvar )
1185
1186
1187	END SELECT
1188
1189	ENDDO
1190
1191	CALL cpu_log( log_point(34), 'sum_up_3d_data', 'stop' )
1192
1193
1194	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 |