Home

Context Navigation

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

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