Home

Context Navigation

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

Last change on this file since 4514 was 4514, checked in by suehring, 5 years ago
Bugfix in plant-canopy model for output of averaged transpiration rate after a restart; Revise check for output for plant heating rate and rename error message number; Surface-data output: enable output of mixing ratio and passive scalar concentration at the surface; Surface-data input: Add possibility to prescribe surface sensible and latent heat fluxes via static input file
Property svn:keywords set to `Id`
File size: 40.6 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	!
[4360]	17	! Copyright 1997-2020 Leibniz Universitaet Hannover
[2000]	18	!------------------------------------------------------------------------------!
[1036]	19	!
[484]	20	! Current revisions:
[3569]	21	! ------------------
[1360]	22	!
[4442]	23	!
[1321]	24	! Former revisions:
	25	! -----------------
	26	! $Id: sum_up_3d_data.f90 4514 2020-04-30 16:29:59Z suehring $
[4514]	27	! Enable output of qsurf and ssurf
	28	!
	29	! 4442 2020-03-04 19:21:13Z suehring
[4442]	30	! Change order of dimension in surface array %frac to allow for better
	31	! vectorization.
	32	!
	33	! 4441 2020-03-04 19:20:35Z suehring
[4331]	34	! Move 2-m potential temperature output to diagnostic_output_quantities
	35	!
	36	! 4182 2019-08-22 15:20:23Z scharf
[4182]	37	! Corrected "Former revisions" section
	38	!
	39	! 4048 2019-06-21 21:00:21Z knoop
[4048]	40	! Moved tcm_3d_data_averaging to module_interface
	41	!
	42	! 4039 2019-06-18 10:32:41Z suehring
[4039]	43	! Modularize diagnostic output
	44	!
	45	! 3994 2019-05-22 18:08:09Z suehring
[3994]	46	! output of turbulence intensity added
	47	!
	48	! 3943 2019-05-02 09:50:41Z maronga
[3943]	49	! Added output of qsws_av for green roofs.
	50	!
	51	! 3933 2019-04-25 12:33:20Z kanani
[3933]	52	! Formatting
	53	!
	54	! 3773 2019-03-01 08:56:57Z maronga
[3773]	55	! Added output of theta_2m*_xy_av
	56	!
	57	! 3761 2019-02-25 15:31:42Z raasch
[3761]	58	! unused variables removed
	59	!
	60	! 3655 2019-01-07 16:51:22Z knoop
[3637]	61	! Implementation of the PALM module interface
[3582]	62	!
[4182]	63	! Revision 1.1 2006/02/23 12:55:23 raasch
	64	! Initial revision
	65	!
	66	!
[1]	67	! Description:
	68	! ------------
[1682]	69	!> Sum-up the values of 3d-arrays. The real averaging is later done in routine
	70	!> average_3d_data.
[1]	71	!------------------------------------------------------------------------------!
[1682]	72	SUBROUTINE sum_up_3d_data
	73
[1]	74
[1320]	75	USE arrays_3d, &
[4331]	76	ONLY: dzw, d_exner, e, heatflux_output_conversion, p, &
	77	pt, q, ql, ql_c, ql_v, s, u, v, vpt, w, &
[3294]	78	waterflux_output_conversion
[1]	79
[1320]	80	USE averaging, &
[3294]	81	ONLY: e_av, ghf_av, lpt_av, lwp_av, ol_av, p_av, pc_av, pr_av, pt_av, &
[4514]	82	q_av, ql_av, ql_c_av, ql_v_av, ql_vp_av, qsurf_av, qsws_av, &
	83	qv_av, r_a_av, s_av, shf_av, ssurf_av, &
	84	ssws_av, ts_av, tsurf_av, u_av, &
[3597]	85	us_av, v_av, vpt_av, w_av, z0_av, z0h_av, z0q_av
[3241]	86
[3274]	87	USE basic_constants_and_equations_mod, &
	88	ONLY: c_p, lv_d_cp, l_v
	89
	90	USE bulk_cloud_model_mod, &
[3637]	91	ONLY: bulk_cloud_model
[3274]	92
[1320]	93	USE control_parameters, &
[3637]	94	ONLY: average_count_3d, doav, doav_n, rho_surface, urban_surface, &
[3569]	95	varnamelength
[1320]	96
	97	USE cpulog, &
	98	ONLY: cpu_log, log_point
	99
	100	USE indices, &
[4514]	101	ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, &
	102	topo_top_ind
[1320]	103
	104	USE kinds
	105
[3637]	106	USE module_interface, &
	107	ONLY: module_interface_3d_data_averaging
[1551]	108
[1320]	109	USE particle_attributes, &
[1359]	110	ONLY: grid_particles, number_of_particles, particles, prt_count
[1320]	111
[2232]	112	USE surface_mod, &
[2963]	113	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, &
	114	surf_def_h, surf_lsm_h, surf_usm_h
[2232]	115
[2007]	116	USE urban_surface_mod, &
[3637]	117	ONLY: usm_3d_data_averaging
[1691]	118
[2007]	119
[1]	120	IMPLICIT NONE
	121
[3170]	122	LOGICAL :: match_def !< flag indicating default-type surface
	123	LOGICAL :: match_lsm !< flag indicating natural-type surface
	124	LOGICAL :: match_usm !< flag indicating urban-type surface
	125
[2232]	126	INTEGER(iwp) :: i !< grid index x direction
[2007]	127	INTEGER(iwp) :: ii !< running index
[2232]	128	INTEGER(iwp) :: j !< grid index y direction
	129	INTEGER(iwp) :: k !< grid index x direction
[3552]	130	INTEGER(iwp) :: m !< running index over surfacle elements
	131	INTEGER(iwp) :: n !< running index over number of particles per grid box
[1]	132
[3552]	133	REAL(wp) :: mean_r !< mean-particle radius witin grid box
	134	REAL(wp) :: s_r2 !< mean-particle radius witin grid box to the power of two
	135	REAL(wp) :: s_r3 !< mean-particle radius witin grid box to the power of three
[1]	136
[2011]	137	CHARACTER (LEN=varnamelength) :: trimvar !< TRIM of output-variable string
[2007]	138
	139
[1]	140	CALL cpu_log (log_point(34),'sum_up_3d_data','start')
	141
	142	!
	143	!-- Allocate and initialize the summation arrays if called for the very first
	144	!-- time or the first time after average_3d_data has been called
	145	!-- (some or all of the arrays may have been already allocated
[2894]	146	!-- in rrd_local)
[1]	147	IF ( average_count_3d == 0 ) THEN
	148
	149	DO ii = 1, doav_n
[3337]	150
[2007]	151	trimvar = TRIM( doav(ii) )
[3337]	152
[2007]	153	SELECT CASE ( trimvar )
[1]	154
[2797]	155	CASE ( 'ghf*' )
	156	IF ( .NOT. ALLOCATED( ghf_av ) ) THEN
	157	ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
	158	ENDIF
	159	ghf_av = 0.0_wp
	160
[1]	161	CASE ( 'e' )
	162	IF ( .NOT. ALLOCATED( e_av ) ) THEN
[667]	163	ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	164	ENDIF
[1353]	165	e_av = 0.0_wp
[1]	166
[3421]	167	CASE ( 'thetal' )
[771]	168	IF ( .NOT. ALLOCATED( lpt_av ) ) THEN
	169	ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	170	ENDIF
[1353]	171	lpt_av = 0.0_wp
[771]	172
[1]	173	CASE ( 'lwp*' )
	174	IF ( .NOT. ALLOCATED( lwp_av ) ) THEN
[667]	175	ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
[1]	176	ENDIF
[1353]	177	lwp_av = 0.0_wp
[1]	178
[1691]	179	CASE ( 'ol*' )
	180	IF ( .NOT. ALLOCATED( ol_av ) ) THEN
	181	ALLOCATE( ol_av(nysg:nyng,nxlg:nxrg) )
	182	ENDIF
	183	ol_av = 0.0_wp
	184
[1]	185	CASE ( 'p' )
	186	IF ( .NOT. ALLOCATED( p_av ) ) THEN
[667]	187	ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	188	ENDIF
[1353]	189	p_av = 0.0_wp
[1]	190
	191	CASE ( 'pc' )
	192	IF ( .NOT. ALLOCATED( pc_av ) ) THEN
[667]	193	ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	194	ENDIF
[1353]	195	pc_av = 0.0_wp
[1]	196
	197	CASE ( 'pr' )
	198	IF ( .NOT. ALLOCATED( pr_av ) ) THEN
[667]	199	ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	200	ENDIF
[1353]	201	pr_av = 0.0_wp
[1]	202
[3421]	203	CASE ( 'theta' )
[1]	204	IF ( .NOT. ALLOCATED( pt_av ) ) THEN
[667]	205	ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	206	ENDIF
[1353]	207	pt_av = 0.0_wp
[1]	208
	209	CASE ( 'q' )
	210	IF ( .NOT. ALLOCATED( q_av ) ) THEN
[667]	211	ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	212	ENDIF
[1353]	213	q_av = 0.0_wp
[1]	214
	215	CASE ( 'ql' )
	216	IF ( .NOT. ALLOCATED( ql_av ) ) THEN
[667]	217	ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	218	ENDIF
[1353]	219	ql_av = 0.0_wp
[1]	220
	221	CASE ( 'ql_c' )
	222	IF ( .NOT. ALLOCATED( ql_c_av ) ) THEN
[667]	223	ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	224	ENDIF
[1353]	225	ql_c_av = 0.0_wp
[1]	226
	227	CASE ( 'ql_v' )
	228	IF ( .NOT. ALLOCATED( ql_v_av ) ) THEN
[667]	229	ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	230	ENDIF
[1353]	231	ql_v_av = 0.0_wp
[1]	232
	233	CASE ( 'ql_vp' )
	234	IF ( .NOT. ALLOCATED( ql_vp_av ) ) THEN
[667]	235	ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	236	ENDIF
[1353]	237	ql_vp_av = 0.0_wp
[1]	238
[4514]	239	CASE ( 'qsurf*' )
	240	IF ( .NOT. ALLOCATED( qsurf_av ) ) THEN
	241	ALLOCATE( qsurf_av(nysg:nyng,nxlg:nxrg) )
	242	ENDIF
	243	qsurf_av = 0.0_wp
	244
[354]	245	CASE ( 'qsws*' )
	246	IF ( .NOT. ALLOCATED( qsws_av ) ) THEN
[667]	247	ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
[354]	248	ENDIF
[1353]	249	qsws_av = 0.0_wp
[354]	250
[1]	251	CASE ( 'qv' )
	252	IF ( .NOT. ALLOCATED( qv_av ) ) THEN
[667]	253	ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	254	ENDIF
[1353]	255	qv_av = 0.0_wp
[1]	256
[2735]	257	CASE ( 'r_a*' )
	258	IF ( .NOT. ALLOCATED( r_a_av ) ) THEN
	259	ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
	260	ENDIF
	261	r_a_av = 0.0_wp
	262
[1]	263	CASE ( 's' )
	264	IF ( .NOT. ALLOCATED( s_av ) ) THEN
[667]	265	ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	266	ENDIF
[1353]	267	s_av = 0.0_wp
[1]	268
[354]	269	CASE ( 'shf*' )
	270	IF ( .NOT. ALLOCATED( shf_av ) ) THEN
[667]	271	ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
[354]	272	ENDIF
[1353]	273	shf_av = 0.0_wp
[4514]	274
	275	CASE ( 'ssurf*' )
	276	IF ( .NOT. ALLOCATED( ssurf_av ) ) THEN
	277	ALLOCATE( ssurf_av(nysg:nyng,nxlg:nxrg) )
	278	ENDIF
	279	ssurf_av = 0.0_wp
	280
[2024]	281	CASE ( 'ssws*' )
	282	IF ( .NOT. ALLOCATED( ssws_av ) ) THEN
	283	ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
	284	ENDIF
	285	ssws_av = 0.0_wp
[354]	286
[1]	287	CASE ( 't*' )
	288	IF ( .NOT. ALLOCATED( ts_av ) ) THEN
[667]	289	ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
[1]	290	ENDIF
[1353]	291	ts_av = 0.0_wp
[1]	292
[2742]	293	CASE ( 'tsurf*' )
	294	IF ( .NOT. ALLOCATED( tsurf_av ) ) THEN
	295	ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
	296	ENDIF
	297	tsurf_av = 0.0_wp
	298
[1]	299	CASE ( 'u' )
	300	IF ( .NOT. ALLOCATED( u_av ) ) THEN
[667]	301	ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	302	ENDIF
[1353]	303	u_av = 0.0_wp
[1]	304
[3421]	305	CASE ( 'us*' )
[1]	306	IF ( .NOT. ALLOCATED( us_av ) ) THEN
[667]	307	ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
[1]	308	ENDIF
[1353]	309	us_av = 0.0_wp
[1]	310
	311	CASE ( 'v' )
	312	IF ( .NOT. ALLOCATED( v_av ) ) THEN
[667]	313	ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	314	ENDIF
[1353]	315	v_av = 0.0_wp
[1]	316
[3421]	317	CASE ( 'thetav' )
[1]	318	IF ( .NOT. ALLOCATED( vpt_av ) ) THEN
[667]	319	ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	320	ENDIF
[1353]	321	vpt_av = 0.0_wp
[1]	322
	323	CASE ( 'w' )
	324	IF ( .NOT. ALLOCATED( w_av ) ) THEN
[667]	325	ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	326	ENDIF
[1353]	327	w_av = 0.0_wp
[1]	328
[72]	329	CASE ( 'z0*' )
	330	IF ( .NOT. ALLOCATED( z0_av ) ) THEN
[667]	331	ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
[72]	332	ENDIF
[1353]	333	z0_av = 0.0_wp
[72]	334
[978]	335	CASE ( 'z0h*' )
	336	IF ( .NOT. ALLOCATED( z0h_av ) ) THEN
	337	ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
	338	ENDIF
[1353]	339	z0h_av = 0.0_wp
[978]	340
[1788]	341	CASE ( 'z0q*' )
	342	IF ( .NOT. ALLOCATED( z0q_av ) ) THEN
	343	ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
	344	ENDIF
	345	z0q_av = 0.0_wp
[3294]	346
[2007]	347
[1]	348	CASE DEFAULT
[1972]	349
[1]	350	!
[3637]	351	!-- Allocating and initializing data arrays for all other modules
	352	CALL module_interface_3d_data_averaging( 'allocate', trimvar )
[3337]	353
[3274]	354
[1]	355	END SELECT
	356
	357	ENDDO
	358
	359	ENDIF
	360
	361	!
	362	!-- Loop of all variables to be averaged.
	363	DO ii = 1, doav_n
[3337]	364
	365	trimvar = TRIM( doav(ii) )
[1]	366	!
	367	!-- Store the array chosen on the temporary array.
[2007]	368	SELECT CASE ( trimvar )
[1]	369
[2797]	370	CASE ( 'ghf*' )
[3004]	371	IF ( ALLOCATED( ghf_av ) ) THEN
[3170]	372	DO i = nxl, nxr
	373	DO j = nys, nyn
	374	!
	375	!-- Check whether grid point is a natural- or urban-type
	376	!-- surface.
	377	match_lsm = surf_lsm_h%start_index(j,i) <= &
	378	surf_lsm_h%end_index(j,i)
	379	match_usm = surf_usm_h%start_index(j,i) <= &
	380	surf_usm_h%end_index(j,i)
	381	!
	382	!-- In order to avoid double-counting of surface properties,
	383	!-- always assume that natural-type surfaces are below urban-
	384	!-- type surfaces, e.g. in case of bridges.
	385	!-- Further, take only the last suface element, i.e. the
	386	!-- uppermost surface which would be visible from above
	387	IF ( match_lsm .AND. .NOT. match_usm ) THEN
	388	m = surf_lsm_h%end_index(j,i)
[3173]	389	ghf_av(j,i) = ghf_av(j,i) + &
[3170]	390	surf_lsm_h%ghf(m)
	391	ELSEIF ( match_usm ) THEN
	392	m = surf_usm_h%end_index(j,i)
[3173]	393	ghf_av(j,i) = ghf_av(j,i) + &
[4441]	394	surf_usm_h%frac(m,ind_veg_wall) * &
[3170]	395	surf_usm_h%wghf_eb(m) + &
[4441]	396	surf_usm_h%frac(m,ind_pav_green) * &
[3170]	397	surf_usm_h%wghf_eb_green(m) + &
[4441]	398	surf_usm_h%frac(m,ind_wat_win) * &
[3170]	399	surf_usm_h%wghf_eb_window(m)
	400	ENDIF
	401	ENDDO
[3004]	402	ENDDO
	403	ENDIF
[2797]	404
[1]	405	CASE ( 'e' )
[3004]	406	IF ( ALLOCATED( e_av ) ) THEN
	407	DO i = nxlg, nxrg
	408	DO j = nysg, nyng
	409	DO k = nzb, nzt+1
	410	e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
	411	ENDDO
[1]	412	ENDDO
	413	ENDDO
[3004]	414	ENDIF
[1]	415
[3421]	416	CASE ( 'thetal' )
[3004]	417	IF ( ALLOCATED( lpt_av ) ) THEN
	418	DO i = nxlg, nxrg
	419	DO j = nysg, nyng
	420	DO k = nzb, nzt+1
	421	lpt_av(k,j,i) = lpt_av(k,j,i) + pt(k,j,i)
	422	ENDDO
[771]	423	ENDDO
	424	ENDDO
[3004]	425	ENDIF
[771]	426
[1]	427	CASE ( 'lwp*' )
[3004]	428	IF ( ALLOCATED( lwp_av ) ) THEN
	429	DO i = nxlg, nxrg
	430	DO j = nysg, nyng
	431	lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) &
	432	* dzw(1:nzt+1) ) * rho_surface
	433	ENDDO
[1]	434	ENDDO
[3004]	435	ENDIF
[1]	436
[1691]	437	CASE ( 'ol*' )
[3004]	438	IF ( ALLOCATED( ol_av ) ) THEN
[3170]	439	DO i = nxl, nxr
	440	DO j = nys, nyn
	441	match_def = surf_def_h(0)%start_index(j,i) <= &
	442	surf_def_h(0)%end_index(j,i)
	443	match_lsm = surf_lsm_h%start_index(j,i) <= &
	444	surf_lsm_h%end_index(j,i)
	445	match_usm = surf_usm_h%start_index(j,i) <= &
	446	surf_usm_h%end_index(j,i)
	447
	448	IF ( match_def ) THEN
	449	m = surf_def_h(0)%end_index(j,i)
[3173]	450	ol_av(j,i) = ol_av(j,i) + &
[3170]	451	surf_def_h(0)%ol(m)
	452	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
	453	m = surf_lsm_h%end_index(j,i)
[3173]	454	ol_av(j,i) = ol_av(j,i) + &
[3170]	455	surf_lsm_h%ol(m)
	456	ELSEIF ( match_usm ) THEN
	457	m = surf_usm_h%end_index(j,i)
[3173]	458	ol_av(j,i) = ol_av(j,i) + &
[3170]	459	surf_usm_h%ol(m)
	460	ENDIF
	461	ENDDO
[3004]	462	ENDDO
	463	ENDIF
[1691]	464
[1]	465	CASE ( 'p' )
[3004]	466	IF ( ALLOCATED( p_av ) ) THEN
	467	DO i = nxlg, nxrg
	468	DO j = nysg, nyng
	469	DO k = nzb, nzt+1
	470	p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
	471	ENDDO
[1]	472	ENDDO
	473	ENDDO
[3004]	474	ENDIF
[1]	475
	476	CASE ( 'pc' )
[3004]	477	IF ( ALLOCATED( pc_av ) ) THEN
	478	DO i = nxl, nxr
	479	DO j = nys, nyn
	480	DO k = nzb, nzt+1
	481	pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
	482	ENDDO
[1]	483	ENDDO
	484	ENDDO
[3004]	485	ENDIF
[1]	486
	487	CASE ( 'pr' )
[3004]	488	IF ( ALLOCATED( pr_av ) ) THEN
	489	DO i = nxl, nxr
	490	DO j = nys, nyn
	491	DO k = nzb, nzt+1
	492	number_of_particles = prt_count(k,j,i)
	493	IF ( number_of_particles <= 0 ) CYCLE
	494	particles => &
	495	grid_particles(k,j,i)%particles(1:number_of_particles)
	496	s_r2 = 0.0_wp
	497	s_r3 = 0.0_wp
[1359]	498
[3004]	499	DO n = 1, number_of_particles
	500	IF ( particles(n)%particle_mask ) THEN
	501	s_r2 = s_r2 + particles(n)%radius*2 &
	502	particles(n)%weight_factor
	503	s_r3 = s_r3 + particles(n)%radius*3 &
	504	particles(n)%weight_factor
	505	ENDIF
	506	ENDDO
	507
	508	IF ( s_r2 > 0.0_wp ) THEN
	509	mean_r = s_r3 / s_r2
	510	ELSE
	511	mean_r = 0.0_wp
[1359]	512	ENDIF
[3004]	513	pr_av(k,j,i) = pr_av(k,j,i) + mean_r
[1]	514	ENDDO
	515	ENDDO
	516	ENDDO
[3004]	517	ENDIF
[1]	518
[3421]	519	CASE ( 'theta' )
[3004]	520	IF ( ALLOCATED( pt_av ) ) THEN
[3274]	521	IF ( .NOT. bulk_cloud_model ) THEN
[3004]	522	DO i = nxlg, nxrg
	523	DO j = nysg, nyng
	524	DO k = nzb, nzt+1
	525	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
	526	ENDDO
[1]	527	ENDDO
	528	ENDDO
[3004]	529	ELSE
	530	DO i = nxlg, nxrg
	531	DO j = nysg, nyng
	532	DO k = nzb, nzt+1
[3274]	533	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + lv_d_cp * &
	534	d_exner(k) * ql(k,j,i)
[3004]	535	ENDDO
[1]	536	ENDDO
	537	ENDDO
[3004]	538	ENDIF
[1]	539	ENDIF
	540
	541	CASE ( 'q' )
[3004]	542	IF ( ALLOCATED( q_av ) ) THEN
	543	DO i = nxlg, nxrg
	544	DO j = nysg, nyng
	545	DO k = nzb, nzt+1
	546	q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
	547	ENDDO
[1]	548	ENDDO
	549	ENDDO
[3004]	550	ENDIF
[402]	551
[1]	552	CASE ( 'ql' )
[3004]	553	IF ( ALLOCATED( ql_av ) ) THEN
	554	DO i = nxlg, nxrg
	555	DO j = nysg, nyng
	556	DO k = nzb, nzt+1
	557	ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
	558	ENDDO
[1]	559	ENDDO
	560	ENDDO
[3004]	561	ENDIF
[1]	562
	563	CASE ( 'ql_c' )
[3004]	564	IF ( ALLOCATED( ql_c_av ) ) THEN
	565	DO i = nxlg, nxrg
	566	DO j = nysg, nyng
	567	DO k = nzb, nzt+1
	568	ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
	569	ENDDO
[1]	570	ENDDO
	571	ENDDO
[3004]	572	ENDIF
[1]	573
	574	CASE ( 'ql_v' )
[3004]	575	IF ( ALLOCATED( ql_v_av ) ) THEN
	576	DO i = nxlg, nxrg
	577	DO j = nysg, nyng
	578	DO k = nzb, nzt+1
	579	ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
	580	ENDDO
[1]	581	ENDDO
	582	ENDDO
[3004]	583	ENDIF
[1]	584
	585	CASE ( 'ql_vp' )
[3004]	586	IF ( ALLOCATED( ql_vp_av ) ) THEN
	587	DO i = nxl, nxr
	588	DO j = nys, nyn
	589	DO k = nzb, nzt+1
	590	number_of_particles = prt_count(k,j,i)
	591	IF ( number_of_particles <= 0 ) CYCLE
	592	particles => &
	593	grid_particles(k,j,i)%particles(1:number_of_particles)
	594	DO n = 1, number_of_particles
	595	IF ( particles(n)%particle_mask ) THEN
	596	ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + &
	597	particles(n)%weight_factor / &
	598	number_of_particles
	599	ENDIF
	600	ENDDO
[1007]	601	ENDDO
[1]	602	ENDDO
	603	ENDDO
[3004]	604	ENDIF
[1]	605
[4514]	606	CASE ( 'qsurf*' )
	607	IF ( ALLOCATED( qsurf_av ) ) THEN
	608	DO i = nxl, nxr
	609	DO j = nys, nyn
	610	match_def = surf_def_h(0)%start_index(j,i) <= &
	611	surf_def_h(0)%end_index(j,i)
	612	match_lsm = surf_lsm_h%start_index(j,i) <= &
	613	surf_lsm_h%end_index(j,i)
	614	match_usm = surf_usm_h%start_index(j,i) <= &
	615	surf_usm_h%end_index(j,i)
	616
	617	IF ( match_def ) THEN
	618	m = surf_def_h(0)%end_index(j,i)
	619	qsurf_av(j,i) = qsurf_av(j,i) + &
	620	surf_def_h(0)%q_surface(m)
	621	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
	622	m = surf_lsm_h%end_index(j,i)
	623	qsurf_av(j,i) = qsurf_av(j,i) + &
	624	surf_lsm_h%q_surface(m)
	625	ELSEIF ( match_usm ) THEN
	626	m = surf_usm_h%end_index(j,i)
	627	qsurf_av(j,i) = qsurf_av(j,i) + &
	628	surf_usm_h%q_surface(m)
	629	ENDIF
	630	ENDDO
	631	ENDDO
	632	ENDIF
	633
[402]	634	CASE ( 'qsws*' )
[2743]	635	!
	636	!-- In case of default surfaces, clean-up flux by density.
	637	!-- In case of land- and urban-surfaces, convert fluxes into
	638	!-- dynamic units.
[3943]	639	!-- Question (maronga): are the .NOT. statements really required?
[3004]	640	IF ( ALLOCATED( qsws_av ) ) THEN
[3170]	641	DO i = nxl, nxr
	642	DO j = nys, nyn
	643	match_def = surf_def_h(0)%start_index(j,i) <= &
	644	surf_def_h(0)%end_index(j,i)
	645	match_lsm = surf_lsm_h%start_index(j,i) <= &
	646	surf_lsm_h%end_index(j,i)
	647	match_usm = surf_usm_h%start_index(j,i) <= &
	648	surf_usm_h%end_index(j,i)
	649
	650	IF ( match_def ) THEN
	651	m = surf_def_h(0)%end_index(j,i)
[3173]	652	qsws_av(j,i) = qsws_av(j,i) + &
[3170]	653	surf_def_h(0)%qsws(m) * &
[3285]	654	waterflux_output_conversion(nzb)
[3170]	655	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
	656	m = surf_lsm_h%end_index(j,i)
[3173]	657	qsws_av(j,i) = qsws_av(j,i) + &
[3170]	658	surf_lsm_h%qsws(m) * l_v
[3943]	659	ELSEIF ( match_usm .AND. .NOT. match_lsm ) THEN
	660	m = surf_usm_h%end_index(j,i)
	661	qsws_av(j,i) = qsws_av(j,i) + &
	662	surf_usm_h%qsws(m) * l_v
[3170]	663	ENDIF
	664	ENDDO
[3004]	665	ENDDO
	666	ENDIF
[402]	667
[1]	668	CASE ( 'qv' )
[3004]	669	IF ( ALLOCATED( qv_av ) ) THEN
	670	DO i = nxlg, nxrg
	671	DO j = nysg, nyng
	672	DO k = nzb, nzt+1
	673	qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
	674	ENDDO
[1]	675	ENDDO
	676	ENDDO
[3004]	677	ENDIF
[1]	678
[2735]	679	CASE ( 'r_a*' )
[3004]	680	IF ( ALLOCATED( r_a_av ) ) THEN
[3170]	681	DO i = nxl, nxr
	682	DO j = nys, nyn
	683	match_lsm = surf_lsm_h%start_index(j,i) <= &
	684	surf_lsm_h%end_index(j,i)
	685	match_usm = surf_usm_h%start_index(j,i) <= &
	686	surf_usm_h%end_index(j,i)
	687
	688	IF ( match_lsm .AND. .NOT. match_usm ) THEN
	689	m = surf_lsm_h%end_index(j,i)
[3173]	690	r_a_av(j,i) = r_a_av(j,i) + &
[3170]	691	surf_lsm_h%r_a(m)
	692	ELSEIF ( match_usm ) THEN
	693	m = surf_usm_h%end_index(j,i)
[3173]	694	r_a_av(j,i) = r_a_av(j,i) + &
[4441]	695	surf_usm_h%frac(m,ind_veg_wall) * &
[3170]	696	surf_usm_h%r_a(m) + &
[4441]	697	surf_usm_h%frac(m,ind_pav_green) * &
[3170]	698	surf_usm_h%r_a_green(m) + &
[4441]	699	surf_usm_h%frac(m,ind_wat_win) * &
[3170]	700	surf_usm_h%r_a_window(m)
	701	ENDIF
	702	ENDDO
[3004]	703	ENDDO
	704	ENDIF
[2735]	705
[1]	706	CASE ( 's' )
[3004]	707	IF ( ALLOCATED( s_av ) ) THEN
	708	DO i = nxlg, nxrg
	709	DO j = nysg, nyng
	710	DO k = nzb, nzt+1
	711	s_av(k,j,i) = s_av(k,j,i) + s(k,j,i)
	712	ENDDO
[1]	713	ENDDO
	714	ENDDO
[3004]	715	ENDIF
[402]	716
	717	CASE ( 'shf*' )
[2743]	718	!
	719	!-- In case of default surfaces, clean-up flux by density.
	720	!-- In case of land- and urban-surfaces, convert fluxes into
	721	!-- dynamic units.
[3004]	722	IF ( ALLOCATED( shf_av ) ) THEN
[3170]	723	DO i = nxl, nxr
	724	DO j = nys, nyn
	725	match_def = surf_def_h(0)%start_index(j,i) <= &
	726	surf_def_h(0)%end_index(j,i)
	727	match_lsm = surf_lsm_h%start_index(j,i) <= &
	728	surf_lsm_h%end_index(j,i)
	729	match_usm = surf_usm_h%start_index(j,i) <= &
	730	surf_usm_h%end_index(j,i)
	731
	732	IF ( match_def ) THEN
	733	m = surf_def_h(0)%end_index(j,i)
[3173]	734	shf_av(j,i) = shf_av(j,i) + &
[3170]	735	surf_def_h(0)%shf(m) * &
[3285]	736	heatflux_output_conversion(nzb)
[3170]	737	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
	738	m = surf_lsm_h%end_index(j,i)
[3173]	739	shf_av(j,i) = shf_av(j,i) + &
[3274]	740	surf_lsm_h%shf(m) * c_p
[3170]	741	ELSEIF ( match_usm ) THEN
	742	m = surf_usm_h%end_index(j,i)
[3173]	743	shf_av(j,i) = shf_av(j,i) + &
[3274]	744	surf_usm_h%shf(m) * c_p
[3170]	745	ENDIF
	746	ENDDO
[3004]	747	ENDDO
	748	ENDIF
[402]	749
[4514]	750	CASE ( 'ssurf*' )
	751	IF ( ALLOCATED( ssurf_av ) ) THEN
	752	DO i = nxl, nxr
	753	DO j = nys, nyn
	754	k = topo_top_ind(j,i,0)
	755	ssurf_av(j,i) = ssurf_av(j,i) + s(k,j,i)
	756	ENDDO
	757	ENDDO
	758	ENDIF
	759
[1960]	760	CASE ( 'ssws*' )
[3004]	761	IF ( ALLOCATED( ssws_av ) ) THEN
[3170]	762	DO i = nxl, nxr
	763	DO j = nys, nyn
	764	match_def = surf_def_h(0)%start_index(j,i) <= &
	765	surf_def_h(0)%end_index(j,i)
	766	match_lsm = surf_lsm_h%start_index(j,i) <= &
	767	surf_lsm_h%end_index(j,i)
	768	match_usm = surf_usm_h%start_index(j,i) <= &
	769	surf_usm_h%end_index(j,i)
	770
	771	IF ( match_def ) THEN
	772	m = surf_def_h(0)%end_index(j,i)
[3173]	773	ssws_av(j,i) = ssws_av(j,i) + &
[3170]	774	surf_def_h(0)%ssws(m)
	775	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
	776	m = surf_lsm_h%end_index(j,i)
[3173]	777	ssws_av(j,i) = ssws_av(j,i) + &
[3170]	778	surf_lsm_h%ssws(m)
	779	ELSEIF ( match_usm ) THEN
	780	m = surf_usm_h%end_index(j,i)
[3173]	781	ssws_av(j,i) = ssws_av(j,i) + &
[3170]	782	surf_usm_h%ssws(m)
	783	ENDIF
	784	ENDDO
[3004]	785	ENDDO
	786	ENDIF
[1960]	787
[1]	788	CASE ( 't*' )
[3004]	789	IF ( ALLOCATED( ts_av ) ) THEN
[3170]	790	DO i = nxl, nxr
	791	DO j = nys, nyn
	792	match_def = surf_def_h(0)%start_index(j,i) <= &
	793	surf_def_h(0)%end_index(j,i)
	794	match_lsm = surf_lsm_h%start_index(j,i) <= &
	795	surf_lsm_h%end_index(j,i)
	796	match_usm = surf_usm_h%start_index(j,i) <= &
	797	surf_usm_h%end_index(j,i)
	798
	799	IF ( match_def ) THEN
	800	m = surf_def_h(0)%end_index(j,i)
[3173]	801	ts_av(j,i) = ts_av(j,i) + &
[3170]	802	surf_def_h(0)%ts(m)
	803	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
	804	m = surf_lsm_h%end_index(j,i)
[3173]	805	ts_av(j,i) = ts_av(j,i) + &
[3170]	806	surf_lsm_h%ts(m)
	807	ELSEIF ( match_usm ) THEN
	808	m = surf_usm_h%end_index(j,i)
[3173]	809	ts_av(j,i) = ts_av(j,i) + &
[3170]	810	surf_usm_h%ts(m)
	811	ENDIF
	812	ENDDO
[3004]	813	ENDDO
	814	ENDIF
[1]	815
[2742]	816	CASE ( 'tsurf*' )
[3170]	817	IF ( ALLOCATED( tsurf_av ) ) THEN
	818	DO i = nxl, nxr
	819	DO j = nys, nyn
	820	match_def = surf_def_h(0)%start_index(j,i) <= &
	821	surf_def_h(0)%end_index(j,i)
	822	match_lsm = surf_lsm_h%start_index(j,i) <= &
	823	surf_lsm_h%end_index(j,i)
	824	match_usm = surf_usm_h%start_index(j,i) <= &
	825	surf_usm_h%end_index(j,i)
[2798]	826
[3170]	827	IF ( match_def ) THEN
	828	m = surf_def_h(0)%end_index(j,i)
	829	tsurf_av(j,i) = tsurf_av(j,i) + &
	830	surf_def_h(0)%pt_surface(m)
	831	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
	832	m = surf_lsm_h%end_index(j,i)
	833	tsurf_av(j,i) = tsurf_av(j,i) + &
	834	surf_lsm_h%pt_surface(m)
	835	ELSEIF ( match_usm ) THEN
	836	m = surf_usm_h%end_index(j,i)
	837	tsurf_av(j,i) = tsurf_av(j,i) + &
	838	surf_usm_h%pt_surface(m)
	839	ENDIF
	840	ENDDO
[3004]	841	ENDDO
	842	ENDIF
[2742]	843
[1]	844	CASE ( 'u' )
[3004]	845	IF ( ALLOCATED( u_av ) ) THEN
	846	DO i = nxlg, nxrg
	847	DO j = nysg, nyng
	848	DO k = nzb, nzt+1
	849	u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
	850	ENDDO
[1]	851	ENDDO
	852	ENDDO
[3004]	853	ENDIF
[1]	854
[3421]	855	CASE ( 'us*' )
[3004]	856	IF ( ALLOCATED( us_av ) ) THEN
[3170]	857	DO i = nxl, nxr
	858	DO j = nys, nyn
	859	match_def = surf_def_h(0)%start_index(j,i) <= &
	860	surf_def_h(0)%end_index(j,i)
	861	match_lsm = surf_lsm_h%start_index(j,i) <= &
	862	surf_lsm_h%end_index(j,i)
	863	match_usm = surf_usm_h%start_index(j,i) <= &
	864	surf_usm_h%end_index(j,i)
	865
	866	IF ( match_def ) THEN
	867	m = surf_def_h(0)%end_index(j,i)
[3173]	868	us_av(j,i) = us_av(j,i) + &
[3170]	869	surf_def_h(0)%us(m)
	870	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
	871	m = surf_lsm_h%end_index(j,i)
[3173]	872	us_av(j,i) = us_av(j,i) + &
[3170]	873	surf_lsm_h%us(m)
	874	ELSEIF ( match_usm ) THEN
	875	m = surf_usm_h%end_index(j,i)
[3173]	876	us_av(j,i) = us_av(j,i) + &
[3170]	877	surf_usm_h%us(m)
	878	ENDIF
	879	ENDDO
[3004]	880	ENDDO
	881	ENDIF
[1]	882
	883	CASE ( 'v' )
[3004]	884	IF ( ALLOCATED( v_av ) ) THEN
	885	DO i = nxlg, nxrg
	886	DO j = nysg, nyng
	887	DO k = nzb, nzt+1
	888	v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
	889	ENDDO
[1]	890	ENDDO
	891	ENDDO
[3004]	892	ENDIF
[1]	893
[3421]	894	CASE ( 'thetav' )
[3004]	895	IF ( ALLOCATED( vpt_av ) ) THEN
	896	DO i = nxlg, nxrg
	897	DO j = nysg, nyng
	898	DO k = nzb, nzt+1
	899	vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
	900	ENDDO
[1]	901	ENDDO
	902	ENDDO
[3004]	903	ENDIF
[1]	904
	905	CASE ( 'w' )
[3004]	906	IF ( ALLOCATED( w_av ) ) THEN
	907	DO i = nxlg, nxrg
	908	DO j = nysg, nyng
	909	DO k = nzb, nzt+1
	910	w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
	911	ENDDO
[1]	912	ENDDO
	913	ENDDO
[3004]	914	ENDIF
[1]	915
[72]	916	CASE ( 'z0*' )
[3004]	917	IF ( ALLOCATED( z0_av ) ) THEN
[3170]	918	DO i = nxl, nxr
	919	DO j = nys, nyn
	920	match_def = surf_def_h(0)%start_index(j,i) <= &
	921	surf_def_h(0)%end_index(j,i)
	922	match_lsm = surf_lsm_h%start_index(j,i) <= &
	923	surf_lsm_h%end_index(j,i)
	924	match_usm = surf_usm_h%start_index(j,i) <= &
	925	surf_usm_h%end_index(j,i)
	926
	927	IF ( match_def ) THEN
	928	m = surf_def_h(0)%end_index(j,i)
[3173]	929	z0_av(j,i) = z0_av(j,i) + &
[3170]	930	surf_def_h(0)%z0(m)
	931	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
	932	m = surf_lsm_h%end_index(j,i)
[3173]	933	z0_av(j,i) = z0_av(j,i) + &
[3170]	934	surf_lsm_h%z0(m)
	935	ELSEIF ( match_usm ) THEN
	936	m = surf_usm_h%end_index(j,i)
[3173]	937	z0_av(j,i) = z0_av(j,i) + &
[3170]	938	surf_usm_h%z0(m)
	939	ENDIF
	940	ENDDO
	941	ENDDO
[3004]	942	ENDIF
[72]	943
[978]	944	CASE ( 'z0h*' )
[3004]	945	IF ( ALLOCATED( z0h_av ) ) THEN
[3170]	946	DO i = nxl, nxr
	947	DO j = nys, nyn
	948	match_def = surf_def_h(0)%start_index(j,i) <= &
	949	surf_def_h(0)%end_index(j,i)
	950	match_lsm = surf_lsm_h%start_index(j,i) <= &
	951	surf_lsm_h%end_index(j,i)
	952	match_usm = surf_usm_h%start_index(j,i) <= &
	953	surf_usm_h%end_index(j,i)
	954
	955	IF ( match_def ) THEN
	956	m = surf_def_h(0)%end_index(j,i)
[3173]	957	z0h_av(j,i) = z0h_av(j,i) + &
[3170]	958	surf_def_h(0)%z0h(m)
	959	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
	960	m = surf_lsm_h%end_index(j,i)
[3173]	961	z0h_av(j,i) = z0h_av(j,i) + &
[3170]	962	surf_lsm_h%z0h(m)
	963	ELSEIF ( match_usm ) THEN
	964	m = surf_usm_h%end_index(j,i)
[3173]	965	z0h_av(j,i) = z0h_av(j,i) + &
[3170]	966	surf_usm_h%z0h(m)
	967	ENDIF
	968	ENDDO
[3004]	969	ENDDO
	970	ENDIF
	971
[1788]	972	CASE ( 'z0q*' )
[3004]	973	IF ( ALLOCATED( z0q_av ) ) THEN
[3170]	974	DO i = nxl, nxr
	975	DO j = nys, nyn
	976	match_def = surf_def_h(0)%start_index(j,i) <= &
	977	surf_def_h(0)%end_index(j,i)
	978	match_lsm = surf_lsm_h%start_index(j,i) <= &
	979	surf_lsm_h%end_index(j,i)
	980	match_usm = surf_usm_h%start_index(j,i) <= &
	981	surf_usm_h%end_index(j,i)
	982
	983	IF ( match_def ) THEN
	984	m = surf_def_h(0)%end_index(j,i)
[3173]	985	z0q_av(j,i) = z0q_av(j,i) + &
[3170]	986	surf_def_h(0)%z0q(m)
	987	ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN
	988	m = surf_lsm_h%end_index(j,i)
[3173]	989	z0q_av(j,i) = z0q_av(j,i) + &
[3170]	990	surf_lsm_h%z0q(m)
	991	ELSEIF ( match_usm ) THEN
	992	m = surf_usm_h%end_index(j,i)
[3173]	993	z0q_av(j,i) = z0q_av(j,i) + &
[3170]	994	surf_usm_h%z0q(m)
	995	ENDIF
	996	ENDDO
[3004]	997	ENDDO
	998	ENDIF
[3294]	999
[1]	1000	CASE DEFAULT
[3274]	1001
[3337]	1002	!-- In case of urban surface variables it should be always checked
	1003	!-- if respective arrays are allocated, at least in case of a restart
	1004	!-- run, as averaged usm arrays are not read from file at the moment.
[3637]	1005	IF ( urban_surface ) THEN
	1006	CALL usm_3d_data_averaging( 'allocate', trimvar )
[3337]	1007	ENDIF
	1008
[2696]	1009	!
[3637]	1010	!-- Summing up data from all other modules
	1011	CALL module_interface_3d_data_averaging( 'sum', trimvar )
	1012
	1013
[1]	1014	END SELECT
	1015
	1016	ENDDO
	1017
[1318]	1018	CALL cpu_log( log_point(34), 'sum_up_3d_data', 'stop' )
[1]	1019
	1020
	1021	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 |