Home

Context Navigation

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

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