Home

Context Navigation

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

Last change on this file since 2796 was 2790, checked in by suehring, 6 years ago
Bugfix in summation of surface sensible and latent heat flux.
Property svn:keywords set to `Id`
File size: 35.1 KB

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