Home

Context Navigation

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

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