Home

Context Navigation

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

Last change on this file since 1634 was 1586, checked in by maronga, 10 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 29.7 KB

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