Home

Context Navigation

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

Last change on this file since 978 was 978, checked in by fricke, 12 years ago
merge fricke branch back into trunk
Property svn:keywords set to `Id`
File size: 15.1 KB

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