Home

Context Navigation

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

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