Home

Context Navigation

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

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