Home

Context Navigation

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

Last change on this file since 1028 was 1008, checked in by franke, 12 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 15.5 KB

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