Home

Context Navigation

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

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

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