Home

Context Navigation

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

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