Home

Context Navigation

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

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