Home

Context Navigation

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

Last change on this file since 567 was 484, checked in by raasch, 15 years ago
typo in file headers removed
Property svn:keywords set to `Id`
File size: 14.1 KB

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