Home

Context Navigation

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

Last change on this file since 2513 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

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	!
[2101]	17	! Copyright 1997-2017 Leibniz Universitaet Hannover
[2000]	18	!------------------------------------------------------------------------------!
[1036]	19	!
[484]	20	! Current revisions:
[1]	21	! -----------------
[1360]	22	!
[2233]	23	!
[1321]	24	! Former revisions:
	25	! -----------------
	26	! $Id: sum_up_3d_data.f90 2292 2017-06-20 09:51:42Z kanani $
[2292]	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
[1321]	32	!
[2233]	33	! 2232 2017-05-30 17:47:52Z suehring
	34	! Adjustments to new surface concept
	35	!
[2032]	36	! 2031 2016-10-21 15:11:58Z knoop
	37	! renamed variable rho to rho_ocean and rho_av to rho_ocean_av
	38	!
[2025]	39	! 2024 2016-10-12 16:42:37Z kanani
	40	! Added missing CASE for ssws*
	41	!
[2012]	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	!
[2008]	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	!
[2001]	52	! 2000 2016-08-20 18:09:15Z knoop
	53	! Forced header and separation lines into 80 columns
	54	!
[1993]	55	! 1992 2016-08-12 15:14:59Z suehring
	56	! Bugfix in summation of passive scalar
	57	!
[1977]	58	! 1976 2016-07-27 13:28:04Z maronga
	59	! Radiation actions are now done directly in the respective module
	60	!
[1973]	61	! 1972 2016-07-26 07:52:02Z maronga
	62	! Land surface actions are now done directly in the respective module
	63	!
[1961]	64	! 1960 2016-07-12 16:34:24Z suehring
	65	! Scalar surface flux added
	66	!
[1950]	67	! 1949 2016-06-17 07:19:16Z maronga
	68	! Bugfix: calculation of lai_av, c_veg_av and c_liq_av.
	69	!
[1851]	70	! 1849 2016-04-08 11:33:18Z hoffmann
	71	! precipitation_rate moved to arrays_3d
[1852]	72	!
[1789]	73	! 1788 2016-03-10 11:01:04Z maronga
	74	! Added z0q and z0q_av
	75	!
[1694]	76	! 1693 2015-10-27 08:35:45Z maronga
	77	! Last revision text corrected
	78	!
[1692]	79	! 1691 2015-10-26 16:17:44Z maronga
	80	! Added output of Obukhov length and radiative heating rates for RRTMG.
[1693]	81	! Corrected output of liquid water path.
[1692]	82	!
[1683]	83	! 1682 2015-10-07 23:56:08Z knoop
	84	! Code annotations made doxygen readable
	85	!
[1586]	86	! 1585 2015-04-30 07:05:52Z maronga
	87	! Adapted for RRTMG
	88	!
[1556]	89	! 1555 2015-03-04 17:44:27Z maronga
	90	! Added output of r_a and r_s
	91	!
[1552]	92	! 1551 2015-03-03 14:18:16Z maronga
	93	! Added support for land surface model and radiation model data.
	94	!
[1360]	95	! 1359 2014-04-11 17:15:14Z hoffmann
	96	! New particle structure integrated.
	97	!
[1354]	98	! 1353 2014-04-08 15:21:23Z heinze
	99	! REAL constants provided with KIND-attribute
	100	!
[1321]	101	! 1320 2014-03-20 08:40:49Z raasch
[1320]	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
[1]	109	!
[1319]	110	! 1318 2014-03-17 13:35:16Z raasch
	111	! barrier argument removed from cpu_log,
	112	! module interfaces removed
	113	!
[1116]	114	! 1115 2013-03-26 18:16:16Z hoffmann
	115	! ql is calculated by calc_liquid_water_content
	116	!
[1054]	117	! 1053 2012-11-13 17:11:03Z hoffmann
	118	! +nr, prr, qr
	119	!
[1037]	120	! 1036 2012-10-22 13:43:42Z raasch
	121	! code put under GPL (PALM 3.9)
	122	!
[1008]	123	! 1007 2012-09-19 14:30:36Z franke
	124	! Bugfix in calculation of ql_vp
	125	!
[979]	126	! 978 2012-08-09 08:28:32Z fricke
	127	! +z0h*
	128	!
[1]	129	! Revision 1.1 2006/02/23 12:55:23 raasch
	130	! Initial revision
	131	!
	132	!
	133	! Description:
	134	! ------------
[1682]	135	!> Sum-up the values of 3d-arrays. The real averaging is later done in routine
	136	!> average_3d_data.
[1]	137	!------------------------------------------------------------------------------!
[1682]	138	SUBROUTINE sum_up_3d_data
	139
[1]	140
[1320]	141	USE arrays_3d, &
[2292]	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
[1]	144
[1320]	145	USE averaging, &
[2292]	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
[1320]	151
	152	USE cloud_parameters, &
[1849]	153	ONLY: l_d_cp, pt_d_t
[1320]	154
	155	USE control_parameters, &
[2232]	156	ONLY: average_count_3d, cloud_physics, doav, doav_n, land_surface, &
	157	rho_surface, urban_surface, varnamelength
[1320]	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
[1551]	167	USE land_surface_model_mod, &
[2232]	168	ONLY: lsm_3d_data_averaging
[1551]	169
[1320]	170	USE particle_attributes, &
[1359]	171	ONLY: grid_particles, number_of_particles, particles, prt_count
[1320]	172
[1551]	173	USE radiation_model_mod, &
[1976]	174	ONLY: radiation, radiation_3d_data_averaging
[1551]	175
[2232]	176	USE surface_mod, &
	177	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
	178
[2007]	179	USE urban_surface_mod, &
[2011]	180	ONLY: usm_average_3d_data
[1691]	181
[2007]	182
[1]	183	IMPLICIT NONE
	184
[2232]	185	INTEGER(iwp) :: i !< grid index x direction
[2007]	186	INTEGER(iwp) :: ii !< running index
[2232]	187	INTEGER(iwp) :: j !< grid index y direction
	188	INTEGER(iwp) :: k !< grid index x direction
	189	INTEGER(iwp) :: m !< running index surface type
[1682]	190	INTEGER(iwp) :: n !<
[1]	191
[1682]	192	REAL(wp) :: mean_r !<
	193	REAL(wp) :: s_r2 !<
	194	REAL(wp) :: s_r3 !<
[1]	195
[2011]	196	CHARACTER (LEN=varnamelength) :: trimvar !< TRIM of output-variable string
[2007]	197
	198
[1]	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
[2007]	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) )
[2011]	213	IF ( urban_surface .AND. trimvar(1:4) == 'usm_' ) THEN
[2007]	214	trimvar = 'usm_output'
	215	ENDIF
	216
	217	SELECT CASE ( trimvar )
[1]	218
	219	CASE ( 'e' )
	220	IF ( .NOT. ALLOCATED( e_av ) ) THEN
[667]	221	ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	222	ENDIF
[1353]	223	e_av = 0.0_wp
[1]	224
[771]	225	CASE ( 'lpt' )
	226	IF ( .NOT. ALLOCATED( lpt_av ) ) THEN
	227	ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	228	ENDIF
[1353]	229	lpt_av = 0.0_wp
[771]	230
[1]	231	CASE ( 'lwp*' )
	232	IF ( .NOT. ALLOCATED( lwp_av ) ) THEN
[667]	233	ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
[1]	234	ENDIF
[1353]	235	lwp_av = 0.0_wp
[1]	236
[2292]	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
[1053]	243	CASE ( 'nr' )
	244	IF ( .NOT. ALLOCATED( nr_av ) ) THEN
	245	ALLOCATE( nr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	246	ENDIF
[1353]	247	nr_av = 0.0_wp
[1053]	248
[1691]	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
[1]	255	CASE ( 'p' )
	256	IF ( .NOT. ALLOCATED( p_av ) ) THEN
[667]	257	ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	258	ENDIF
[1353]	259	p_av = 0.0_wp
[1]	260
	261	CASE ( 'pc' )
	262	IF ( .NOT. ALLOCATED( pc_av ) ) THEN
[667]	263	ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	264	ENDIF
[1353]	265	pc_av = 0.0_wp
[1]	266
	267	CASE ( 'pr' )
	268	IF ( .NOT. ALLOCATED( pr_av ) ) THEN
[667]	269	ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	270	ENDIF
[1353]	271	pr_av = 0.0_wp
[1]	272
[1053]	273	CASE ( 'prr' )
	274	IF ( .NOT. ALLOCATED( prr_av ) ) THEN
	275	ALLOCATE( prr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	276	ENDIF
[1353]	277	prr_av = 0.0_wp
[1053]	278
[72]	279	CASE ( 'prr*' )
	280	IF ( .NOT. ALLOCATED( precipitation_rate_av ) ) THEN
[667]	281	ALLOCATE( precipitation_rate_av(nysg:nyng,nxlg:nxrg) )
[72]	282	ENDIF
[1353]	283	precipitation_rate_av = 0.0_wp
[72]	284
[1]	285	CASE ( 'pt' )
	286	IF ( .NOT. ALLOCATED( pt_av ) ) THEN
[667]	287	ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	288	ENDIF
[1353]	289	pt_av = 0.0_wp
[1]	290
	291	CASE ( 'q' )
	292	IF ( .NOT. ALLOCATED( q_av ) ) THEN
[667]	293	ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	294	ENDIF
[1353]	295	q_av = 0.0_wp
[1]	296
[1115]	297	CASE ( 'qc' )
	298	IF ( .NOT. ALLOCATED( qc_av ) ) THEN
	299	ALLOCATE( qc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	300	ENDIF
[1353]	301	qc_av = 0.0_wp
[1115]	302
[1]	303	CASE ( 'ql' )
	304	IF ( .NOT. ALLOCATED( ql_av ) ) THEN
[667]	305	ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	306	ENDIF
[1353]	307	ql_av = 0.0_wp
[1]	308
	309	CASE ( 'ql_c' )
	310	IF ( .NOT. ALLOCATED( ql_c_av ) ) THEN
[667]	311	ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	312	ENDIF
[1353]	313	ql_c_av = 0.0_wp
[1]	314
	315	CASE ( 'ql_v' )
	316	IF ( .NOT. ALLOCATED( ql_v_av ) ) THEN
[667]	317	ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	318	ENDIF
[1353]	319	ql_v_av = 0.0_wp
[1]	320
	321	CASE ( 'ql_vp' )
	322	IF ( .NOT. ALLOCATED( ql_vp_av ) ) THEN
[667]	323	ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	324	ENDIF
[1353]	325	ql_vp_av = 0.0_wp
[1]	326
[1053]	327	CASE ( 'qr' )
	328	IF ( .NOT. ALLOCATED( qr_av ) ) THEN
	329	ALLOCATE( qr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	330	ENDIF
[1353]	331	qr_av = 0.0_wp
[1053]	332
[354]	333	CASE ( 'qsws*' )
	334	IF ( .NOT. ALLOCATED( qsws_av ) ) THEN
[667]	335	ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
[354]	336	ENDIF
[1353]	337	qsws_av = 0.0_wp
[354]	338
[1]	339	CASE ( 'qv' )
	340	IF ( .NOT. ALLOCATED( qv_av ) ) THEN
[667]	341	ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	342	ENDIF
[1353]	343	qv_av = 0.0_wp
[1]	344
[2031]	345	CASE ( 'rho_ocean' )
	346	IF ( .NOT. ALLOCATED( rho_ocean_av ) ) THEN
	347	ALLOCATE( rho_ocean_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[96]	348	ENDIF
[2031]	349	rho_ocean_av = 0.0_wp
[96]	350
[1]	351	CASE ( 's' )
	352	IF ( .NOT. ALLOCATED( s_av ) ) THEN
[667]	353	ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	354	ENDIF
[1353]	355	s_av = 0.0_wp
[1]	356
[96]	357	CASE ( 'sa' )
	358	IF ( .NOT. ALLOCATED( sa_av ) ) THEN
[667]	359	ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[96]	360	ENDIF
[1353]	361	sa_av = 0.0_wp
[96]	362
[354]	363	CASE ( 'shf*' )
	364	IF ( .NOT. ALLOCATED( shf_av ) ) THEN
[667]	365	ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
[354]	366	ENDIF
[1353]	367	shf_av = 0.0_wp
[2024]	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
[354]	374
[1]	375	CASE ( 't*' )
	376	IF ( .NOT. ALLOCATED( ts_av ) ) THEN
[667]	377	ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
[1]	378	ENDIF
[1353]	379	ts_av = 0.0_wp
[1]	380
	381	CASE ( 'u' )
	382	IF ( .NOT. ALLOCATED( u_av ) ) THEN
[667]	383	ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	384	ENDIF
[1353]	385	u_av = 0.0_wp
[1]	386
	387	CASE ( 'u*' )
	388	IF ( .NOT. ALLOCATED( us_av ) ) THEN
[667]	389	ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
[1]	390	ENDIF
[1353]	391	us_av = 0.0_wp
[1]	392
	393	CASE ( 'v' )
	394	IF ( .NOT. ALLOCATED( v_av ) ) THEN
[667]	395	ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	396	ENDIF
[1353]	397	v_av = 0.0_wp
[1]	398
	399	CASE ( 'vpt' )
	400	IF ( .NOT. ALLOCATED( vpt_av ) ) THEN
[667]	401	ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	402	ENDIF
[1353]	403	vpt_av = 0.0_wp
[1]	404
	405	CASE ( 'w' )
	406	IF ( .NOT. ALLOCATED( w_av ) ) THEN
[667]	407	ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	408	ENDIF
[1353]	409	w_av = 0.0_wp
[1]	410
[72]	411	CASE ( 'z0*' )
	412	IF ( .NOT. ALLOCATED( z0_av ) ) THEN
[667]	413	ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
[72]	414	ENDIF
[1353]	415	z0_av = 0.0_wp
[72]	416
[978]	417	CASE ( 'z0h*' )
	418	IF ( .NOT. ALLOCATED( z0h_av ) ) THEN
	419	ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
	420	ENDIF
[1353]	421	z0h_av = 0.0_wp
[978]	422
[1788]	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
[2007]	428	!
	429	!-- Block of urban surface model outputs
	430	CASE ( 'usm_output' )
[1788]	431
[2007]	432	CALL usm_average_3d_data( 'allocate', doav(ii) )
	433
	434
[1]	435	CASE DEFAULT
[1972]	436
[1]	437	!
[1972]	438	!-- Land surface quantity
	439	IF ( land_surface ) THEN
	440	CALL lsm_3d_data_averaging( 'allocate', doav(ii) )
	441	ENDIF
	442
	443	!
[1976]	444	!-- Radiation quantity
	445	IF ( radiation ) THEN
	446	CALL radiation_3d_data_averaging( 'allocate', doav(ii) )
	447	ENDIF
	448
	449	!
[1]	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	!
[2007]	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) )
[2011]	466	IF ( urban_surface .AND. trimvar(1:4) == 'usm_' ) THEN
[2007]	467	trimvar = 'usm_output'
	468	ENDIF
	469	!
[1]	470	!-- Store the array chosen on the temporary array.
[2007]	471	SELECT CASE ( trimvar )
[1]	472
	473	CASE ( 'e' )
[667]	474	DO i = nxlg, nxrg
	475	DO j = nysg, nyng
[1]	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
[771]	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
[1]	491	CASE ( 'lwp*' )
[667]	492	DO i = nxlg, nxrg
	493	DO j = nysg, nyng
[1691]	494	lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) &
	495	* dzw(1:nzt+1) ) * rho_surface
[1]	496	ENDDO
	497	ENDDO
	498
[2292]	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
[1053]	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
[1691]	517	CASE ( 'ol*' )
[2232]	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)
[1691]	522	ENDDO
[2232]	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
[1691]	533
[1]	534	CASE ( 'p' )
[667]	535	DO i = nxlg, nxrg
	536	DO j = nysg, nyng
[1]	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
[1359]	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
[1353]	560	s_r3 = 0.0_wp
[1359]	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
[1]	569	ENDDO
[1359]	570
	571	IF ( s_r2 > 0.0_wp ) THEN
	572	mean_r = s_r3 / s_r2
[1]	573	ELSE
[1353]	574	mean_r = 0.0_wp
[1]	575	ENDIF
	576	pr_av(k,j,i) = pr_av(k,j,i) + mean_r
	577	ENDDO
	578	ENDDO
	579	ENDDO
	580
[1359]	581
[72]	582	CASE ( 'pr*' )
[667]	583	DO i = nxlg, nxrg
	584	DO j = nysg, nyng
[72]	585	precipitation_rate_av(j,i) = precipitation_rate_av(j,i) + &
	586	precipitation_rate(j,i)
	587	ENDDO
	588	ENDDO
	589
[1]	590	CASE ( 'pt' )
	591	IF ( .NOT. cloud_physics ) THEN
[667]	592	DO i = nxlg, nxrg
	593	DO j = nysg, nyng
	594	DO k = nzb, nzt+1
[1]	595	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
	596	ENDDO
	597	ENDDO
	598	ENDDO
	599	ELSE
[667]	600	DO i = nxlg, nxrg
	601	DO j = nysg, nyng
	602	DO k = nzb, nzt+1
[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' )
[667]	611	DO i = nxlg, nxrg
	612	DO j = nysg, nyng
[1]	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
[402]	618
[1115]	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
[1]	628	CASE ( 'ql' )
[667]	629	DO i = nxlg, nxrg
	630	DO j = nysg, nyng
[1]	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' )
[667]	638	DO i = nxlg, nxrg
	639	DO j = nysg, nyng
[1]	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' )
[667]	647	DO i = nxlg, nxrg
	648	DO j = nysg, nyng
[1]	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' )
[1007]	656	DO i = nxl, nxr
	657	DO j = nys, nyn
[1]	658	DO k = nzb, nzt+1
[1359]	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
[1007]	668	ENDDO
[1]	669	ENDDO
	670	ENDDO
	671	ENDDO
	672
[1053]	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
[402]	682	CASE ( 'qsws*' )
[2232]	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)
[402]	687	ENDDO
[2232]	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
[402]	698
[1]	699	CASE ( 'qv' )
[667]	700	DO i = nxlg, nxrg
	701	DO j = nysg, nyng
[1]	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
[2031]	708	CASE ( 'rho_ocean' )
[667]	709	DO i = nxlg, nxrg
	710	DO j = nysg, nyng
[96]	711	DO k = nzb, nzt+1
[2031]	712	rho_ocean_av(k,j,i) = rho_ocean_av(k,j,i) + rho_ocean(k,j,i)
[96]	713	ENDDO
	714	ENDDO
	715	ENDDO
[402]	716
[1]	717	CASE ( 's' )
[667]	718	DO i = nxlg, nxrg
	719	DO j = nysg, nyng
[1]	720	DO k = nzb, nzt+1
[1992]	721	s_av(k,j,i) = s_av(k,j,i) + s(k,j,i)
[1]	722	ENDDO
	723	ENDDO
	724	ENDDO
[402]	725
[96]	726	CASE ( 'sa' )
[667]	727	DO i = nxlg, nxrg
	728	DO j = nysg, nyng
[96]	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
[402]	734
	735	CASE ( 'shf*' )
[2232]	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)
[402]	740	ENDDO
[2232]	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
[402]	751
[2232]	752
[1960]	753	CASE ( 'ssws*' )
[2232]	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)
[1960]	758	ENDDO
[2232]	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
[1960]	769
[1]	770	CASE ( 't*' )
[2232]	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)
[1]	775	ENDDO
[2232]	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
[1]	786
	787	CASE ( 'u' )
[667]	788	DO i = nxlg, nxrg
	789	DO j = nysg, nyng
[1]	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*' )
[2232]	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)
[1]	801	ENDDO
[2232]	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
[1]	812
	813	CASE ( 'v' )
[667]	814	DO i = nxlg, nxrg
	815	DO j = nysg, nyng
[1]	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' )
[667]	823	DO i = nxlg, nxrg
	824	DO j = nysg, nyng
[1]	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' )
[667]	832	DO i = nxlg, nxrg
	833	DO j = nysg, nyng
[1]	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
[72]	840	CASE ( 'z0*' )
[2232]	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)
[72]	845	ENDDO
[2232]	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
[72]	856
[978]	857	CASE ( 'z0h*' )
[2232]	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)
[978]	862	ENDDO
[2232]	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
[978]	873
[1788]	874	CASE ( 'z0q*' )
[2232]	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)
[1788]	879	ENDDO
[2232]	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
[2007]	890	!
	891	!-- Block of urban surface model outputs
	892	CASE ( 'usm_output' )
	893	CALL usm_average_3d_data( 'sum', doav(ii) )
[1788]	894
[1]	895	CASE DEFAULT
	896	!
[1972]	897	!-- Land surface quantity
	898	IF ( land_surface ) THEN
	899	CALL lsm_3d_data_averaging( 'sum', doav(ii) )
	900	ENDIF
	901
	902	!
[1976]	903	!-- Radiation quantity
	904	IF ( radiation ) THEN
	905	CALL radiation_3d_data_averaging( 'sum', doav(ii) )
	906	ENDIF
	907
	908	!
[1]	909	!-- User-defined quantity
	910	CALL user_3d_data_averaging( 'sum', doav(ii) )
	911
	912	END SELECT
	913
	914	ENDDO
	915
[1318]	916	CALL cpu_log( log_point(34), 'sum_up_3d_data', 'stop' )
[1]	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 |