Home

Context Navigation

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

Last change on this file since 4623 was 4591, checked in by raasch, 4 years ago
files re-formatted to follow the PALM coding standard
Property svn:keywords set to `Id`
File size: 42.9 KB

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