Home

Context Navigation

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

Last change on this file since 1069 was 1054, checked in by hoffmann, 12 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 17.4 KB

Rev	Line
[1]	1	SUBROUTINE sum_up_3d_data
	2
[1036]	3	!--------------------------------------------------------------------------------!
	4	! This file is part of PALM.
	5	!
	6	! PALM is free software: you can redistribute it and/or modify it under the terms
	7	! of the GNU General Public License as published by the Free Software Foundation,
	8	! either version 3 of the License, or (at your option) any later version.
	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	!
	17	! Copyright 1997-2012 Leibniz University Hannover
	18	!--------------------------------------------------------------------------------!
	19	!
[484]	20	! Current revisions:
[1]	21	! -----------------
	22	!
	23	! Former revisions:
	24	! -----------------
[3]	25	! $Id: sum_up_3d_data.f90 1054 2012-11-13 17:30:09Z maronga $
[77]	26	!
[1054]	27	! 1053 2012-11-13 17:11:03Z hoffmann
	28	! +nr, prr, qr
	29	!
[1037]	30	! 1036 2012-10-22 13:43:42Z raasch
	31	! code put under GPL (PALM 3.9)
	32	!
[1008]	33	! 1007 2012-09-19 14:30:36Z franke
	34	! Bugfix in calculation of ql_vp
	35	!
[979]	36	! 978 2012-08-09 08:28:32Z fricke
	37	! +z0h*
	38	!
[791]	39	! 790 2011-11-29 03:11:20Z raasch
	40	! bugfix: calculation of 'pr' must depend on the particle weighting factor
	41	!
[772]	42	! 771 2011-10-27 10:56:21Z heinze
	43	! +lpt_av
	44	!
[668]	45	! 667 2010-12-23 12:06:00Z suehring/gryschka
	46	! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
	47	!
[482]	48	! 402 2009-10-21 11:59:41Z maronga
	49	! Bugfix in calculation of shf_av, qsws_av
	50	!
[392]	51	! 2009-08-25 08:35:52Z maronga
	52	! +shf, qsws
	53	!
[98]	54	! 96 2007-06-04 08:07:41Z raasch
	55	! +sum-up of density and salinity
	56	!
[77]	57	! 72 2007-03-19 08:20:46Z raasch
	58	! +sum-up of precipitation rate and roughness length (prr, z0)
	59	!
[3]	60	! RCS Log replace by Id keyword, revision history cleaned up
	61	!
[1]	62	! Revision 1.1 2006/02/23 12:55:23 raasch
	63	! Initial revision
	64	!
	65	!
	66	! Description:
	67	! ------------
	68	! Sum-up the values of 3d-arrays. The real averaging is later done in routine
	69	! average_3d_data.
	70	!------------------------------------------------------------------------------!
	71
	72	USE arrays_3d
	73	USE averaging
	74	USE cloud_parameters
	75	USE control_parameters
	76	USE cpulog
	77	USE indices
	78	USE interfaces
	79	USE particle_attributes
	80
	81	IMPLICIT NONE
	82
	83	INTEGER :: i, ii, j, k, n, psi
	84
	85	REAL :: mean_r, s_r3, s_r4
	86
	87
	88	CALL cpu_log (log_point(34),'sum_up_3d_data','start')
	89
	90	!
	91	!-- Allocate and initialize the summation arrays if called for the very first
	92	!-- time or the first time after average_3d_data has been called
	93	!-- (some or all of the arrays may have been already allocated
	94	!-- in read_3d_binary)
	95	IF ( average_count_3d == 0 ) THEN
	96
	97	DO ii = 1, doav_n
	98
	99	SELECT CASE ( TRIM( doav(ii) ) )
	100
	101	CASE ( 'e' )
	102	IF ( .NOT. ALLOCATED( e_av ) ) THEN
[667]	103	ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	104	ENDIF
	105	e_av = 0.0
	106
[771]	107	CASE ( 'lpt' )
	108	IF ( .NOT. ALLOCATED( lpt_av ) ) THEN
	109	ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	110	ENDIF
	111	lpt_av = 0.0
	112
[1]	113	CASE ( 'lwp*' )
	114	IF ( .NOT. ALLOCATED( lwp_av ) ) THEN
[667]	115	ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
[1]	116	ENDIF
	117	lwp_av = 0.0
	118
[1053]	119	CASE ( 'nr' )
	120	IF ( .NOT. ALLOCATED( nr_av ) ) THEN
	121	ALLOCATE( nr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	122	ENDIF
	123	nr_av = 0.0
	124
[1]	125	CASE ( 'p' )
	126	IF ( .NOT. ALLOCATED( p_av ) ) THEN
[667]	127	ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	128	ENDIF
	129	p_av = 0.0
	130
	131	CASE ( 'pc' )
	132	IF ( .NOT. ALLOCATED( pc_av ) ) THEN
[667]	133	ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	134	ENDIF
	135	pc_av = 0.0
	136
	137	CASE ( 'pr' )
	138	IF ( .NOT. ALLOCATED( pr_av ) ) THEN
[667]	139	ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	140	ENDIF
	141	pr_av = 0.0
	142
[1053]	143	CASE ( 'prr' )
	144	IF ( .NOT. ALLOCATED( prr_av ) ) THEN
	145	ALLOCATE( prr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	146	ENDIF
	147	prr_av = 0.0
	148
[72]	149	CASE ( 'prr*' )
	150	IF ( .NOT. ALLOCATED( precipitation_rate_av ) ) THEN
[667]	151	ALLOCATE( precipitation_rate_av(nysg:nyng,nxlg:nxrg) )
[72]	152	ENDIF
	153	precipitation_rate_av = 0.0
	154
[1]	155	CASE ( 'pt' )
	156	IF ( .NOT. ALLOCATED( pt_av ) ) THEN
[667]	157	ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	158	ENDIF
	159	pt_av = 0.0
	160
	161	CASE ( 'q' )
	162	IF ( .NOT. ALLOCATED( q_av ) ) THEN
[667]	163	ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	164	ENDIF
	165	q_av = 0.0
	166
	167	CASE ( 'ql' )
	168	IF ( .NOT. ALLOCATED( ql_av ) ) THEN
[667]	169	ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	170	ENDIF
	171	ql_av = 0.0
	172
	173	CASE ( 'ql_c' )
	174	IF ( .NOT. ALLOCATED( ql_c_av ) ) THEN
[667]	175	ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	176	ENDIF
	177	ql_c_av = 0.0
	178
	179	CASE ( 'ql_v' )
	180	IF ( .NOT. ALLOCATED( ql_v_av ) ) THEN
[667]	181	ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	182	ENDIF
	183	ql_v_av = 0.0
	184
	185	CASE ( 'ql_vp' )
	186	IF ( .NOT. ALLOCATED( ql_vp_av ) ) THEN
[667]	187	ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	188	ENDIF
	189	ql_vp_av = 0.0
	190
[1053]	191	CASE ( 'qr' )
	192	IF ( .NOT. ALLOCATED( qr_av ) ) THEN
	193	ALLOCATE( qr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	194	ENDIF
	195	qr_av = 0.0
	196
[354]	197	CASE ( 'qsws*' )
	198	IF ( .NOT. ALLOCATED( qsws_av ) ) THEN
[667]	199	ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
[354]	200	ENDIF
	201	qsws_av = 0.0
	202
[1]	203	CASE ( 'qv' )
	204	IF ( .NOT. ALLOCATED( qv_av ) ) THEN
[667]	205	ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	206	ENDIF
	207	qv_av = 0.0
	208
[96]	209	CASE ( 'rho' )
	210	IF ( .NOT. ALLOCATED( rho_av ) ) THEN
[667]	211	ALLOCATE( rho_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[96]	212	ENDIF
	213	rho_av = 0.0
	214
[1]	215	CASE ( 's' )
	216	IF ( .NOT. ALLOCATED( s_av ) ) THEN
[667]	217	ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	218	ENDIF
	219	s_av = 0.0
	220
[96]	221	CASE ( 'sa' )
	222	IF ( .NOT. ALLOCATED( sa_av ) ) THEN
[667]	223	ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[96]	224	ENDIF
	225	sa_av = 0.0
	226
[354]	227	CASE ( 'shf*' )
	228	IF ( .NOT. ALLOCATED( shf_av ) ) THEN
[667]	229	ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
[354]	230	ENDIF
	231	shf_av = 0.0
	232
[1]	233	CASE ( 't*' )
	234	IF ( .NOT. ALLOCATED( ts_av ) ) THEN
[667]	235	ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
[1]	236	ENDIF
	237	ts_av = 0.0
	238
	239	CASE ( 'u' )
	240	IF ( .NOT. ALLOCATED( u_av ) ) THEN
[667]	241	ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	242	ENDIF
	243	u_av = 0.0
	244
	245	CASE ( 'u*' )
	246	IF ( .NOT. ALLOCATED( us_av ) ) THEN
[667]	247	ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
[1]	248	ENDIF
	249	us_av = 0.0
	250
	251	CASE ( 'v' )
	252	IF ( .NOT. ALLOCATED( v_av ) ) THEN
[667]	253	ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	254	ENDIF
	255	v_av = 0.0
	256
	257	CASE ( 'vpt' )
	258	IF ( .NOT. ALLOCATED( vpt_av ) ) THEN
[667]	259	ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	260	ENDIF
	261	vpt_av = 0.0
	262
	263	CASE ( 'w' )
	264	IF ( .NOT. ALLOCATED( w_av ) ) THEN
[667]	265	ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]	266	ENDIF
	267	w_av = 0.0
	268
[72]	269	CASE ( 'z0*' )
	270	IF ( .NOT. ALLOCATED( z0_av ) ) THEN
[667]	271	ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
[72]	272	ENDIF
	273	z0_av = 0.0
	274
[978]	275	CASE ( 'z0h*' )
	276	IF ( .NOT. ALLOCATED( z0h_av ) ) THEN
	277	ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
	278	ENDIF
	279	z0h_av = 0.0
	280
[1]	281	CASE DEFAULT
	282	!
	283	!-- User-defined quantity
	284	CALL user_3d_data_averaging( 'allocate', doav(ii) )
	285
	286	END SELECT
	287
	288	ENDDO
	289
	290	ENDIF
	291
	292	!
	293	!-- Loop of all variables to be averaged.
	294	DO ii = 1, doav_n
	295
	296	!
	297	!-- Store the array chosen on the temporary array.
	298	SELECT CASE ( TRIM( doav(ii) ) )
	299
	300	CASE ( 'e' )
[667]	301	DO i = nxlg, nxrg
	302	DO j = nysg, nyng
[1]	303	DO k = nzb, nzt+1
	304	e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
	305	ENDDO
	306	ENDDO
	307	ENDDO
	308
[771]	309	CASE ( 'lpt' )
	310	DO i = nxlg, nxrg
	311	DO j = nysg, nyng
	312	DO k = nzb, nzt+1
	313	lpt_av(k,j,i) = lpt_av(k,j,i) + pt(k,j,i)
	314	ENDDO
	315	ENDDO
	316	ENDDO
	317
[1]	318	CASE ( 'lwp*' )
[667]	319	DO i = nxlg, nxrg
	320	DO j = nysg, nyng
[1]	321	lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) * &
	322	dzw(1:nzt+1) )
	323	ENDDO
	324	ENDDO
	325
[1053]	326	CASE ( 'nr' )
	327	DO i = nxlg, nxrg
	328	DO j = nysg, nyng
	329	DO k = nzb, nzt+1
	330	nr_av(k,j,i) = nr_av(k,j,i) + nr(k,j,i)
	331	ENDDO
	332	ENDDO
	333	ENDDO
	334
[1]	335	CASE ( 'p' )
[667]	336	DO i = nxlg, nxrg
	337	DO j = nysg, nyng
[1]	338	DO k = nzb, nzt+1
	339	p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
	340	ENDDO
	341	ENDDO
	342	ENDDO
	343
	344	CASE ( 'pc' )
	345	DO i = nxl, nxr
	346	DO j = nys, nyn
	347	DO k = nzb, nzt+1
	348	pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
	349	ENDDO
	350	ENDDO
	351	ENDDO
	352
	353	CASE ( 'pr' )
	354	DO i = nxl, nxr
	355	DO j = nys, nyn
	356	DO k = nzb, nzt+1
	357	psi = prt_start_index(k,j,i)
	358	s_r3 = 0.0
	359	s_r4 = 0.0
	360	DO n = psi, psi+prt_count(k,j,i)-1
[790]	361	s_r3 = s_r3 + particles(n)%radius*3 &
	362	particles(n)%weight_factor
	363	s_r4 = s_r4 + particles(n)%radius*4 &
	364	particles(n)%weight_factor
[1]	365	ENDDO
	366	IF ( s_r3 /= 0.0 ) THEN
	367	mean_r = s_r4 / s_r3
	368	ELSE
	369	mean_r = 0.0
	370	ENDIF
	371	pr_av(k,j,i) = pr_av(k,j,i) + mean_r
	372	ENDDO
	373	ENDDO
	374	ENDDO
	375
[72]	376	CASE ( 'pr*' )
[667]	377	DO i = nxlg, nxrg
	378	DO j = nysg, nyng
[72]	379	precipitation_rate_av(j,i) = precipitation_rate_av(j,i) + &
	380	precipitation_rate(j,i)
	381	ENDDO
	382	ENDDO
	383
[1]	384	CASE ( 'pt' )
	385	IF ( .NOT. cloud_physics ) THEN
[667]	386	DO i = nxlg, nxrg
	387	DO j = nysg, nyng
	388	DO k = nzb, nzt+1
[1]	389	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
	390	ENDDO
	391	ENDDO
	392	ENDDO
	393	ELSE
[667]	394	DO i = nxlg, nxrg
	395	DO j = nysg, nyng
	396	DO k = nzb, nzt+1
[1]	397	pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + l_d_cp * &
	398	pt_d_t(k) * ql(k,j,i)
	399	ENDDO
	400	ENDDO
	401	ENDDO
	402	ENDIF
	403
	404	CASE ( 'q' )
[667]	405	DO i = nxlg, nxrg
	406	DO j = nysg, nyng
[1]	407	DO k = nzb, nzt+1
	408	q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
	409	ENDDO
	410	ENDDO
	411	ENDDO
[402]	412
[1]	413	CASE ( 'ql' )
[667]	414	DO i = nxlg, nxrg
	415	DO j = nysg, nyng
[1]	416	DO k = nzb, nzt+1
	417	ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
	418	ENDDO
	419	ENDDO
	420	ENDDO
	421
	422	CASE ( 'ql_c' )
[667]	423	DO i = nxlg, nxrg
	424	DO j = nysg, nyng
[1]	425	DO k = nzb, nzt+1
	426	ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
	427	ENDDO
	428	ENDDO
	429	ENDDO
	430
	431	CASE ( 'ql_v' )
[667]	432	DO i = nxlg, nxrg
	433	DO j = nysg, nyng
[1]	434	DO k = nzb, nzt+1
	435	ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
	436	ENDDO
	437	ENDDO
	438	ENDDO
	439
	440	CASE ( 'ql_vp' )
[1007]	441	DO i = nxl, nxr
	442	DO j = nys, nyn
[1]	443	DO k = nzb, nzt+1
[1007]	444	psi = prt_start_index(k,j,i)
	445	DO n = psi, psi+prt_count(k,j,i)-1
	446	ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + &
	447	particles(n)%weight_factor / &
	448	prt_count(k,j,i)
	449	ENDDO
[1]	450	ENDDO
	451	ENDDO
	452	ENDDO
	453
[1053]	454	CASE ( 'qr' )
	455	DO i = nxlg, nxrg
	456	DO j = nysg, nyng
	457	DO k = nzb, nzt+1
	458	qr_av(k,j,i) = qr_av(k,j,i) + qr(k,j,i)
	459	ENDDO
	460	ENDDO
	461	ENDDO
	462
[402]	463	CASE ( 'qsws*' )
[667]	464	DO i = nxlg, nxrg
	465	DO j = nysg, nyng
[402]	466	qsws_av(j,i) = qsws_av(j,i) + qsws(j,i)
	467	ENDDO
	468	ENDDO
	469
[1]	470	CASE ( 'qv' )
[667]	471	DO i = nxlg, nxrg
	472	DO j = nysg, nyng
[1]	473	DO k = nzb, nzt+1
	474	qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
	475	ENDDO
	476	ENDDO
	477	ENDDO
	478
[96]	479	CASE ( 'rho' )
[667]	480	DO i = nxlg, nxrg
	481	DO j = nysg, nyng
[96]	482	DO k = nzb, nzt+1
	483	rho_av(k,j,i) = rho_av(k,j,i) + rho(k,j,i)
	484	ENDDO
	485	ENDDO
	486	ENDDO
[402]	487
[1]	488	CASE ( 's' )
[667]	489	DO i = nxlg, nxrg
	490	DO j = nysg, nyng
[1]	491	DO k = nzb, nzt+1
	492	s_av(k,j,i) = s_av(k,j,i) + q(k,j,i)
	493	ENDDO
	494	ENDDO
	495	ENDDO
[402]	496
[96]	497	CASE ( 'sa' )
[667]	498	DO i = nxlg, nxrg
	499	DO j = nysg, nyng
[96]	500	DO k = nzb, nzt+1
	501	sa_av(k,j,i) = sa_av(k,j,i) + sa(k,j,i)
	502	ENDDO
	503	ENDDO
	504	ENDDO
[402]	505
	506	CASE ( 'shf*' )
[667]	507	DO i = nxlg, nxrg
	508	DO j = nysg, nyng
[402]	509	shf_av(j,i) = shf_av(j,i) + shf(j,i)
	510	ENDDO
	511	ENDDO
	512
[1]	513	CASE ( 't*' )
[667]	514	DO i = nxlg, nxrg
	515	DO j = nysg, nyng
[1]	516	ts_av(j,i) = ts_av(j,i) + ts(j,i)
	517	ENDDO
	518	ENDDO
	519
	520	CASE ( 'u' )
[667]	521	DO i = nxlg, nxrg
	522	DO j = nysg, nyng
[1]	523	DO k = nzb, nzt+1
	524	u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
	525	ENDDO
	526	ENDDO
	527	ENDDO
	528
	529	CASE ( 'u*' )
[667]	530	DO i = nxlg, nxrg
	531	DO j = nysg, nyng
[1]	532	us_av(j,i) = us_av(j,i) + us(j,i)
	533	ENDDO
	534	ENDDO
	535
	536	CASE ( 'v' )
[667]	537	DO i = nxlg, nxrg
	538	DO j = nysg, nyng
[1]	539	DO k = nzb, nzt+1
	540	v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
	541	ENDDO
	542	ENDDO
	543	ENDDO
	544
	545	CASE ( 'vpt' )
[667]	546	DO i = nxlg, nxrg
	547	DO j = nysg, nyng
[1]	548	DO k = nzb, nzt+1
	549	vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
	550	ENDDO
	551	ENDDO
	552	ENDDO
	553
	554	CASE ( 'w' )
[667]	555	DO i = nxlg, nxrg
	556	DO j = nysg, nyng
[1]	557	DO k = nzb, nzt+1
	558	w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
	559	ENDDO
	560	ENDDO
	561	ENDDO
	562
[72]	563	CASE ( 'z0*' )
[667]	564	DO i = nxlg, nxrg
	565	DO j = nysg, nyng
[72]	566	z0_av(j,i) = z0_av(j,i) + z0(j,i)
	567	ENDDO
	568	ENDDO
	569
[978]	570	CASE ( 'z0h*' )
	571	DO i = nxlg, nxrg
	572	DO j = nysg, nyng
	573	z0h_av(j,i) = z0h_av(j,i) + z0h(j,i)
	574	ENDDO
	575	ENDDO
	576
[1]	577	CASE DEFAULT
	578	!
	579	!-- User-defined quantity
	580	CALL user_3d_data_averaging( 'sum', doav(ii) )
	581
	582	END SELECT
	583
	584	ENDDO
	585
	586	CALL cpu_log (log_point(34),'sum_up_3d_data','stop','nobarrier')
	587
	588
	589	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 |