Home

Context Navigation

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

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