Home

Context Navigation

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

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