Home

Context Navigation

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

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