Home

Context Navigation

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

Last change on this file since 1997 was 1993, checked in by suehring, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 23.0 KB

Rev	Line
[1682]	1	!> @file sum_up_3d_data.f90
[1036]	2	!--------------------------------------------------------------------------------!
	3	! This file is part of PALM.
	4	!
	5	! PALM is free software: you can redistribute it and/or modify it under the terms
	6	! of the GNU General Public License as published by the Free Software Foundation,
	7	! either version 3 of the License, or (at your option) any later version.
	8	!
	9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
	10	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	11	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	12	!
	13	! You should have received a copy of the GNU General Public License along with
	14	! PALM. If not, see <http://www.gnu.org/licenses/>.
	15	!
[1818]	16	! Copyright 1997-2016 Leibniz Universitaet Hannover
[1036]	17	!--------------------------------------------------------------------------------!
	18	!
[484]	19	! Current revisions:
[1]	20	! -----------------
[1360]	21	!
[1993]	22	!
[1321]	23	! Former revisions:
	24	! -----------------
	25	! $Id: sum_up_3d_data.f90 1993 2016-08-12 15:16:41Z suehring $
	26	!
[1993]	27	! 1992 2016-08-12 15:14:59Z suehring
	28	! Bugfix in summation of passive scalar
	29	!
[1977]	30	! 1976 2016-07-27 13:28:04Z maronga
	31	! Radiation actions are now done directly in the respective module
	32	!
[1973]	33	! 1972 2016-07-26 07:52:02Z maronga
	34	! Land surface actions are now done directly in the respective module
	35	!
[1961]	36	! 1960 2016-07-12 16:34:24Z suehring
	37	! Scalar surface flux added
	38	!
[1950]	39	! 1949 2016-06-17 07:19:16Z maronga
	40	! Bugfix: calculation of lai_av, c_veg_av and c_liq_av.
	41	!
[1851]	42	! 1849 2016-04-08 11:33:18Z hoffmann
	43	! precipitation_rate moved to arrays_3d
[1852]	44	!
[1789]	45	! 1788 2016-03-10 11:01:04Z maronga
	46	! Added z0q and z0q_av
	47	!
[1694]	48	! 1693 2015-10-27 08:35:45Z maronga
	49	! Last revision text corrected
	50	!
[1692]	51	! 1691 2015-10-26 16:17:44Z maronga
	52	! Added output of Obukhov length and radiative heating rates for RRTMG.
[1693]	53	! Corrected output of liquid water path.
[1692]	54	!
[1683]	55	! 1682 2015-10-07 23:56:08Z knoop
	56	! Code annotations made doxygen readable
	57	!
[1586]	58	! 1585 2015-04-30 07:05:52Z maronga
	59	! Adapted for RRTMG
	60	!
[1556]	61	! 1555 2015-03-04 17:44:27Z maronga
	62	! Added output of r_a and r_s
	63	!
[1552]	64	! 1551 2015-03-03 14:18:16Z maronga
	65	! Added support for land surface model and radiation model data.
	66	!
[1360]	67	! 1359 2014-04-11 17:15:14Z hoffmann
	68	! New particle structure integrated.
	69	!
[1354]	70	! 1353 2014-04-08 15:21:23Z heinze
	71	! REAL constants provided with KIND-attribute
	72	!
[1321]	73	! 1320 2014-03-20 08:40:49Z raasch
[1320]	74	! ONLY-attribute added to USE-statements,
	75	! kind-parameters added to all INTEGER and REAL declaration statements,
	76	! kinds are defined in new module kinds,
	77	! old module precision_kind is removed,
	78	! revision history before 2012 removed,
	79	! comment fields (!:) to be used for variable explanations added to
	80	! all variable declaration statements
[1]	81	!
[1319]	82	! 1318 2014-03-17 13:35:16Z raasch
	83	! barrier argument removed from cpu_log,
	84	! module interfaces removed
	85	!
[1116]	86	! 1115 2013-03-26 18:16:16Z hoffmann
	87	! ql is calculated by calc_liquid_water_content
	88	!
[1054]	89	! 1053 2012-11-13 17:11:03Z hoffmann
	90	! +nr, prr, qr
	91	!
[1037]	92	! 1036 2012-10-22 13:43:42Z raasch
	93	! code put under GPL (PALM 3.9)
	94	!
[1008]	95	! 1007 2012-09-19 14:30:36Z franke
	96	! Bugfix in calculation of ql_vp
	97	!
[979]	98	! 978 2012-08-09 08:28:32Z fricke
	99	! +z0h*
	100	!
[1]	101	! Revision 1.1 2006/02/23 12:55:23 raasch
	102	! Initial revision
	103	!
	104	!
	105	! Description:
	106	! ------------
[1682]	107	!> Sum-up the values of 3d-arrays. The real averaging is later done in routine
	108	!> average_3d_data.
[1]	109	!------------------------------------------------------------------------------!
[1682]	110	SUBROUTINE sum_up_3d_data
	111
[1]	112
[1320]	113	USE arrays_3d, &
[1849]	114	ONLY: dzw, e, nr, ol, p, pt, precipitation_rate, q, qc, ql, ql_c, &
[1992]	115	ql_v, qr, qsws, rho, s, sa, shf, ssws, ts, u, us, v, vpt, w, z0,&
[1960]	116	z0h, z0q
[1]	117
[1320]	118	USE averaging, &
[1691]	119	ONLY: e_av, lpt_av, lwp_av, nr_av, ol_av, p_av, pc_av, pr_av, prr_av, &
[1320]	120	precipitation_rate_av, pt_av, q_av, qc_av, ql_av, ql_c_av, &
	121	ql_v_av, ql_vp_av, qr_av, qsws_av, qv_av, rho_av, s_av, sa_av, &
[1960]	122	shf_av, ssws_av, ts_av, u_av, us_av, v_av, vpt_av, w_av, z0_av, &
	123	z0h_av, z0q_av
[1320]	124
	125	USE cloud_parameters, &
[1849]	126	ONLY: l_d_cp, pt_d_t
[1320]	127
	128	USE control_parameters, &
[1691]	129	ONLY: average_count_3d, cloud_physics, doav, doav_n, rho_surface
[1320]	130
	131	USE cpulog, &
	132	ONLY: cpu_log, log_point
	133
	134	USE indices, &
	135	ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
	136
	137	USE kinds
	138
[1551]	139	USE land_surface_model_mod, &
[1972]	140	ONLY: land_surface, lsm_3d_data_averaging
[1551]	141
[1320]	142	USE particle_attributes, &
[1359]	143	ONLY: grid_particles, number_of_particles, particles, prt_count
[1320]	144
[1551]	145	USE radiation_model_mod, &
[1976]	146	ONLY: radiation, radiation_3d_data_averaging
[1551]	147
[1691]	148
[1]	149	IMPLICIT NONE
	150
[1682]	151	INTEGER(iwp) :: i !<
	152	INTEGER(iwp) :: ii !<
	153	INTEGER(iwp) :: j !<
	154	INTEGER(iwp) :: k !<
	155	INTEGER(iwp) :: n !<
	156	INTEGER(iwp) :: psi !<
[1]	157
[1682]	158	REAL(wp) :: mean_r !<
	159	REAL(wp) :: s_r2 !<
	160	REAL(wp) :: s_r3 !<
[1]	161
	162	CALL cpu_log (log_point(34),'sum_up_3d_data','start')
	163
	164	!
	165	!-- Allocate and initialize the summation arrays if called for the very first
	166	!-- time or the first time after average_3d_data has been called
	167	!-- (some or all of the arrays may have been already allocated
	168	!-- in read_3d_binary)
	169	IF ( average_count_3d == 0 ) THEN
	170
	171	DO ii = 1, doav_n
	172
	173	SELECT CASE ( TRIM( doav(ii) ) )
	174
	175	CASE ( 'e' )
	176	IF ( .NOT. ALLOCATED( e_av ) ) THEN
[667]	177	ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	178	ENDIF
[1353]	179	e_av = 0.0_wp
[1]	180
[771]	181	CASE ( 'lpt' )
	182	IF ( .NOT. ALLOCATED( lpt_av ) ) THEN
	183	ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	184	ENDIF
[1353]	185	lpt_av = 0.0_wp
[771]	186
[1]	187	CASE ( 'lwp*' )
	188	IF ( .NOT. ALLOCATED( lwp_av ) ) THEN
[667]	189	ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
[1]	190	ENDIF
[1353]	191	lwp_av = 0.0_wp
[1]	192
[1053]	193	CASE ( 'nr' )
	194	IF ( .NOT. ALLOCATED( nr_av ) ) THEN
	195	ALLOCATE( nr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	196	ENDIF
[1353]	197	nr_av = 0.0_wp
[1053]	198
[1691]	199	CASE ( 'ol*' )
	200	IF ( .NOT. ALLOCATED( ol_av ) ) THEN
	201	ALLOCATE( ol_av(nysg:nyng,nxlg:nxrg) )
	202	ENDIF
	203	ol_av = 0.0_wp
	204
[1]	205	CASE ( 'p' )
	206	IF ( .NOT. ALLOCATED( p_av ) ) THEN
[667]	207	ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	208	ENDIF
[1353]	209	p_av = 0.0_wp
[1]	210
	211	CASE ( 'pc' )
	212	IF ( .NOT. ALLOCATED( pc_av ) ) THEN
[667]	213	ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	214	ENDIF
[1353]	215	pc_av = 0.0_wp
[1]	216
	217	CASE ( 'pr' )
	218	IF ( .NOT. ALLOCATED( pr_av ) ) THEN
[667]	219	ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	220	ENDIF
[1353]	221	pr_av = 0.0_wp
[1]	222
[1053]	223	CASE ( 'prr' )
	224	IF ( .NOT. ALLOCATED( prr_av ) ) THEN
	225	ALLOCATE( prr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	226	ENDIF
[1353]	227	prr_av = 0.0_wp
[1053]	228
[72]	229	CASE ( 'prr*' )
	230	IF ( .NOT. ALLOCATED( precipitation_rate_av ) ) THEN
[667]	231	ALLOCATE( precipitation_rate_av(nysg:nyng,nxlg:nxrg) )
[72]	232	ENDIF
[1353]	233	precipitation_rate_av = 0.0_wp
[72]	234
[1]	235	CASE ( 'pt' )
	236	IF ( .NOT. ALLOCATED( pt_av ) ) THEN
[667]	237	ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	238	ENDIF
[1353]	239	pt_av = 0.0_wp
[1]	240
	241	CASE ( 'q' )
	242	IF ( .NOT. ALLOCATED( q_av ) ) THEN
[667]	243	ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	244	ENDIF
[1353]	245	q_av = 0.0_wp
[1]	246
[1115]	247	CASE ( 'qc' )
	248	IF ( .NOT. ALLOCATED( qc_av ) ) THEN
	249	ALLOCATE( qc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	250	ENDIF
[1353]	251	qc_av = 0.0_wp
[1115]	252
[1]	253	CASE ( 'ql' )
	254	IF ( .NOT. ALLOCATED( ql_av ) ) THEN
[667]	255	ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	256	ENDIF
[1353]	257	ql_av = 0.0_wp
[1]	258
	259	CASE ( 'ql_c' )
	260	IF ( .NOT. ALLOCATED( ql_c_av ) ) THEN
[667]	261	ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	262	ENDIF
[1353]	263	ql_c_av = 0.0_wp
[1]	264
	265	CASE ( 'ql_v' )
	266	IF ( .NOT. ALLOCATED( ql_v_av ) ) THEN
[667]	267	ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	268	ENDIF
[1353]	269	ql_v_av = 0.0_wp
[1]	270
	271	CASE ( 'ql_vp' )
	272	IF ( .NOT. ALLOCATED( ql_vp_av ) ) THEN
[667]	273	ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	274	ENDIF
[1353]	275	ql_vp_av = 0.0_wp
[1]	276
[1053]	277	CASE ( 'qr' )
	278	IF ( .NOT. ALLOCATED( qr_av ) ) THEN
	279	ALLOCATE( qr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	280	ENDIF
[1353]	281	qr_av = 0.0_wp
[1053]	282
[354]	283	CASE ( 'qsws*' )
	284	IF ( .NOT. ALLOCATED( qsws_av ) ) THEN
[667]	285	ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
[354]	286	ENDIF
[1353]	287	qsws_av = 0.0_wp
[354]	288
[1]	289	CASE ( 'qv' )
	290	IF ( .NOT. ALLOCATED( qv_av ) ) THEN
[667]	291	ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	292	ENDIF
[1353]	293	qv_av = 0.0_wp
[1]	294
[96]	295	CASE ( 'rho' )
	296	IF ( .NOT. ALLOCATED( rho_av ) ) THEN
[667]	297	ALLOCATE( rho_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[96]	298	ENDIF
[1353]	299	rho_av = 0.0_wp
[96]	300
[1]	301	CASE ( 's' )
	302	IF ( .NOT. ALLOCATED( s_av ) ) THEN
[667]	303	ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	304	ENDIF
[1353]	305	s_av = 0.0_wp
[1]	306
[96]	307	CASE ( 'sa' )
	308	IF ( .NOT. ALLOCATED( sa_av ) ) THEN
[667]	309	ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[96]	310	ENDIF
[1353]	311	sa_av = 0.0_wp
[96]	312
[354]	313	CASE ( 'shf*' )
	314	IF ( .NOT. ALLOCATED( shf_av ) ) THEN
[667]	315	ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
[354]	316	ENDIF
[1353]	317	shf_av = 0.0_wp
[354]	318
[1]	319	CASE ( 't*' )
	320	IF ( .NOT. ALLOCATED( ts_av ) ) THEN
[667]	321	ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
[1]	322	ENDIF
[1353]	323	ts_av = 0.0_wp
[1]	324
	325	CASE ( 'u' )
	326	IF ( .NOT. ALLOCATED( u_av ) ) THEN
[667]	327	ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	328	ENDIF
[1353]	329	u_av = 0.0_wp
[1]	330
	331	CASE ( 'u*' )
	332	IF ( .NOT. ALLOCATED( us_av ) ) THEN
[667]	333	ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
[1]	334	ENDIF
[1353]	335	us_av = 0.0_wp
[1]	336
	337	CASE ( 'v' )
	338	IF ( .NOT. ALLOCATED( v_av ) ) THEN
[667]	339	ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	340	ENDIF
[1353]	341	v_av = 0.0_wp
[1]	342
	343	CASE ( 'vpt' )
	344	IF ( .NOT. ALLOCATED( vpt_av ) ) THEN
[667]	345	ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	346	ENDIF
[1353]	347	vpt_av = 0.0_wp
[1]	348
	349	CASE ( 'w' )
	350	IF ( .NOT. ALLOCATED( w_av ) ) THEN
[667]	351	ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	352	ENDIF
[1353]	353	w_av = 0.0_wp
[1]	354
[72]	355	CASE ( 'z0*' )
	356	IF ( .NOT. ALLOCATED( z0_av ) ) THEN
[667]	357	ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
[72]	358	ENDIF
[1353]	359	z0_av = 0.0_wp
[72]	360
[978]	361	CASE ( 'z0h*' )
	362	IF ( .NOT. ALLOCATED( z0h_av ) ) THEN
	363	ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
	364	ENDIF
[1353]	365	z0h_av = 0.0_wp
[978]	366
[1788]	367	CASE ( 'z0q*' )
	368	IF ( .NOT. ALLOCATED( z0q_av ) ) THEN
	369	ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
	370	ENDIF
	371	z0q_av = 0.0_wp
	372
[1]	373	CASE DEFAULT
[1972]	374
[1]	375	!
[1972]	376	!-- Land surface quantity
	377	IF ( land_surface ) THEN
	378	CALL lsm_3d_data_averaging( 'allocate', doav(ii) )
	379	ENDIF
	380
	381	!
[1976]	382	!-- Radiation quantity
	383	IF ( radiation ) THEN
	384	CALL radiation_3d_data_averaging( 'allocate', doav(ii) )
	385	ENDIF
	386
	387	!
[1]	388	!-- User-defined quantity
	389	CALL user_3d_data_averaging( 'allocate', doav(ii) )
	390
	391	END SELECT
	392
	393	ENDDO
	394
	395	ENDIF
	396
	397	!
	398	!-- Loop of all variables to be averaged.
	399	DO ii = 1, doav_n
	400
	401	!
	402	!-- Store the array chosen on the temporary array.
	403	SELECT CASE ( TRIM( doav(ii) ) )
	404
	405	CASE ( 'e' )
[667]	406	DO i = nxlg, nxrg
	407	DO j = nysg, nyng
[1]	408	DO k = nzb, nzt+1
	409	e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
	410	ENDDO
	411	ENDDO
	412	ENDDO
	413
[771]	414	CASE ( 'lpt' )
	415	DO i = nxlg, nxrg
	416	DO j = nysg, nyng
	417	DO k = nzb, nzt+1
	418	lpt_av(k,j,i) = lpt_av(k,j,i) + pt(k,j,i)
	419	ENDDO
	420	ENDDO
	421	ENDDO
	422
[1]	423	CASE ( 'lwp*' )
[667]	424	DO i = nxlg, nxrg
	425	DO j = nysg, nyng
[1691]	426	lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) &
	427	* dzw(1:nzt+1) ) * rho_surface
[1]	428	ENDDO
	429	ENDDO
	430
[1053]	431	CASE ( 'nr' )
	432	DO i = nxlg, nxrg
	433	DO j = nysg, nyng
	434	DO k = nzb, nzt+1
	435	nr_av(k,j,i) = nr_av(k,j,i) + nr(k,j,i)
	436	ENDDO
	437	ENDDO
	438	ENDDO
	439
[1691]	440	CASE ( 'ol*' )
	441	DO i = nxlg, nxrg
	442	DO j = nysg, nyng
	443	ol_av(j,i) = ol_av(j,i) + ol(j,i)
	444	ENDDO
	445	ENDDO
	446
[1]	447	CASE ( 'p' )
[667]	448	DO i = nxlg, nxrg
	449	DO j = nysg, nyng
[1]	450	DO k = nzb, nzt+1
	451	p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
	452	ENDDO
	453	ENDDO
	454	ENDDO
	455
	456	CASE ( 'pc' )
	457	DO i = nxl, nxr
	458	DO j = nys, nyn
	459	DO k = nzb, nzt+1
	460	pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
	461	ENDDO
	462	ENDDO
	463	ENDDO
	464
	465	CASE ( 'pr' )
	466	DO i = nxl, nxr
	467	DO j = nys, nyn
	468	DO k = nzb, nzt+1
[1359]	469	number_of_particles = prt_count(k,j,i)
	470	IF ( number_of_particles <= 0 ) CYCLE
	471	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
	472	s_r2 = 0.0_wp
[1353]	473	s_r3 = 0.0_wp
[1359]	474
	475	DO n = 1, number_of_particles
	476	IF ( particles(n)%particle_mask ) THEN
	477	s_r2 = s_r2 + particles(n)%radius*2 &
	478	particles(n)%weight_factor
	479	s_r3 = s_r3 + particles(n)%radius*3 &
	480	particles(n)%weight_factor
	481	ENDIF
[1]	482	ENDDO
[1359]	483
	484	IF ( s_r2 > 0.0_wp ) THEN
	485	mean_r = s_r3 / s_r2
[1]	486	ELSE
[1353]	487	mean_r = 0.0_wp
[1]	488	ENDIF
	489	pr_av(k,j,i) = pr_av(k,j,i) + mean_r
	490	ENDDO
	491	ENDDO
	492	ENDDO
	493
[1359]	494
[72]	495	CASE ( 'pr*' )
[667]	496	DO i = nxlg, nxrg
	497	DO j = nysg, nyng
[72]	498	precipitation_rate_av(j,i) = precipitation_rate_av(j,i) + &
	499	precipitation_rate(j,i)
	500	ENDDO
	501	ENDDO
	502
[1]	503	CASE ( 'pt' )
	504	IF ( .NOT. cloud_physics ) THEN
[667]	505	DO i = nxlg, nxrg
	506	DO j = nysg, nyng
	507	DO k = nzb, nzt+1
[1]	508	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
	509	ENDDO
	510	ENDDO
	511	ENDDO
	512	ELSE
[667]	513	DO i = nxlg, nxrg
	514	DO j = nysg, nyng
	515	DO k = nzb, nzt+1
[1]	516	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + l_d_cp * &
	517	pt_d_t(k) * ql(k,j,i)
	518	ENDDO
	519	ENDDO
	520	ENDDO
	521	ENDIF
	522
	523	CASE ( 'q' )
[667]	524	DO i = nxlg, nxrg
	525	DO j = nysg, nyng
[1]	526	DO k = nzb, nzt+1
	527	q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
	528	ENDDO
	529	ENDDO
	530	ENDDO
[402]	531
[1115]	532	CASE ( 'qc' )
	533	DO i = nxlg, nxrg
	534	DO j = nysg, nyng
	535	DO k = nzb, nzt+1
	536	qc_av(k,j,i) = qc_av(k,j,i) + qc(k,j,i)
	537	ENDDO
	538	ENDDO
	539	ENDDO
	540
[1]	541	CASE ( 'ql' )
[667]	542	DO i = nxlg, nxrg
	543	DO j = nysg, nyng
[1]	544	DO k = nzb, nzt+1
	545	ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
	546	ENDDO
	547	ENDDO
	548	ENDDO
	549
	550	CASE ( 'ql_c' )
[667]	551	DO i = nxlg, nxrg
	552	DO j = nysg, nyng
[1]	553	DO k = nzb, nzt+1
	554	ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
	555	ENDDO
	556	ENDDO
	557	ENDDO
	558
	559	CASE ( 'ql_v' )
[667]	560	DO i = nxlg, nxrg
	561	DO j = nysg, nyng
[1]	562	DO k = nzb, nzt+1
	563	ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
	564	ENDDO
	565	ENDDO
	566	ENDDO
	567
	568	CASE ( 'ql_vp' )
[1007]	569	DO i = nxl, nxr
	570	DO j = nys, nyn
[1]	571	DO k = nzb, nzt+1
[1359]	572	number_of_particles = prt_count(k,j,i)
	573	IF ( number_of_particles <= 0 ) CYCLE
	574	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
	575	DO n = 1, number_of_particles
	576	IF ( particles(n)%particle_mask ) THEN
	577	ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + &
	578	particles(n)%weight_factor / &
	579	number_of_particles
	580	ENDIF
[1007]	581	ENDDO
[1]	582	ENDDO
	583	ENDDO
	584	ENDDO
	585
[1053]	586	CASE ( 'qr' )
	587	DO i = nxlg, nxrg
	588	DO j = nysg, nyng
	589	DO k = nzb, nzt+1
	590	qr_av(k,j,i) = qr_av(k,j,i) + qr(k,j,i)
	591	ENDDO
	592	ENDDO
	593	ENDDO
	594
[402]	595	CASE ( 'qsws*' )
[667]	596	DO i = nxlg, nxrg
	597	DO j = nysg, nyng
[402]	598	qsws_av(j,i) = qsws_av(j,i) + qsws(j,i)
	599	ENDDO
	600	ENDDO
	601
[1]	602	CASE ( 'qv' )
[667]	603	DO i = nxlg, nxrg
	604	DO j = nysg, nyng
[1]	605	DO k = nzb, nzt+1
	606	qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
	607	ENDDO
	608	ENDDO
	609	ENDDO
	610
[96]	611	CASE ( 'rho' )
[667]	612	DO i = nxlg, nxrg
	613	DO j = nysg, nyng
[96]	614	DO k = nzb, nzt+1
	615	rho_av(k,j,i) = rho_av(k,j,i) + rho(k,j,i)
	616	ENDDO
	617	ENDDO
	618	ENDDO
[402]	619
[1]	620	CASE ( 's' )
[667]	621	DO i = nxlg, nxrg
	622	DO j = nysg, nyng
[1]	623	DO k = nzb, nzt+1
[1992]	624	s_av(k,j,i) = s_av(k,j,i) + s(k,j,i)
[1]	625	ENDDO
	626	ENDDO
	627	ENDDO
[402]	628
[96]	629	CASE ( 'sa' )
[667]	630	DO i = nxlg, nxrg
	631	DO j = nysg, nyng
[96]	632	DO k = nzb, nzt+1
	633	sa_av(k,j,i) = sa_av(k,j,i) + sa(k,j,i)
	634	ENDDO
	635	ENDDO
	636	ENDDO
[402]	637
	638	CASE ( 'shf*' )
[667]	639	DO i = nxlg, nxrg
	640	DO j = nysg, nyng
[402]	641	shf_av(j,i) = shf_av(j,i) + shf(j,i)
	642	ENDDO
	643	ENDDO
	644
[1960]	645	CASE ( 'ssws*' )
	646	DO i = nxlg, nxrg
	647	DO j = nysg, nyng
	648	ssws_av(j,i) = ssws_av(j,i) + ssws(j,i)
	649	ENDDO
	650	ENDDO
	651
[1]	652	CASE ( 't*' )
[667]	653	DO i = nxlg, nxrg
	654	DO j = nysg, nyng
[1]	655	ts_av(j,i) = ts_av(j,i) + ts(j,i)
	656	ENDDO
	657	ENDDO
	658
	659	CASE ( 'u' )
[667]	660	DO i = nxlg, nxrg
	661	DO j = nysg, nyng
[1]	662	DO k = nzb, nzt+1
	663	u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
	664	ENDDO
	665	ENDDO
	666	ENDDO
	667
	668	CASE ( 'u*' )
[667]	669	DO i = nxlg, nxrg
	670	DO j = nysg, nyng
[1]	671	us_av(j,i) = us_av(j,i) + us(j,i)
	672	ENDDO
	673	ENDDO
	674
	675	CASE ( 'v' )
[667]	676	DO i = nxlg, nxrg
	677	DO j = nysg, nyng
[1]	678	DO k = nzb, nzt+1
	679	v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
	680	ENDDO
	681	ENDDO
	682	ENDDO
	683
	684	CASE ( 'vpt' )
[667]	685	DO i = nxlg, nxrg
	686	DO j = nysg, nyng
[1]	687	DO k = nzb, nzt+1
	688	vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
	689	ENDDO
	690	ENDDO
	691	ENDDO
	692
	693	CASE ( 'w' )
[667]	694	DO i = nxlg, nxrg
	695	DO j = nysg, nyng
[1]	696	DO k = nzb, nzt+1
	697	w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
	698	ENDDO
	699	ENDDO
	700	ENDDO
	701
[72]	702	CASE ( 'z0*' )
[667]	703	DO i = nxlg, nxrg
	704	DO j = nysg, nyng
[72]	705	z0_av(j,i) = z0_av(j,i) + z0(j,i)
	706	ENDDO
	707	ENDDO
	708
[978]	709	CASE ( 'z0h*' )
	710	DO i = nxlg, nxrg
	711	DO j = nysg, nyng
	712	z0h_av(j,i) = z0h_av(j,i) + z0h(j,i)
	713	ENDDO
	714	ENDDO
	715
[1788]	716	CASE ( 'z0q*' )
	717	DO i = nxlg, nxrg
	718	DO j = nysg, nyng
	719	z0q_av(j,i) = z0q_av(j,i) + z0q(j,i)
	720	ENDDO
	721	ENDDO
	722
[1]	723	CASE DEFAULT
	724	!
[1972]	725	!-- Land surface quantity
	726	IF ( land_surface ) THEN
	727	CALL lsm_3d_data_averaging( 'sum', doav(ii) )
	728	ENDIF
	729
	730	!
[1976]	731	!-- Radiation quantity
	732	IF ( radiation ) THEN
	733	CALL radiation_3d_data_averaging( 'sum', doav(ii) )
	734	ENDIF
	735
	736	!
[1]	737	!-- User-defined quantity
	738	CALL user_3d_data_averaging( 'sum', doav(ii) )
	739
	740	END SELECT
	741
	742	ENDDO
	743
[1318]	744	CALL cpu_log( log_point(34), 'sum_up_3d_data', 'stop' )
[1]	745
	746
	747	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 |