Home

Context Navigation

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

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