Home

Context Navigation

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

Last change on this file since 2412 was 2292, checked in by schwenkel, 7 years ago
implementation of new bulk microphysics scheme
Property svn:keywords set to `Id`
File size: 29.8 KB

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