Home

Context Navigation

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

Last change on this file since 767 was 668, checked in by suehring, 14 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 14.0 KB

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