Home

Context Navigation

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

Last change on this file since 70 was 4, checked in by raasch, 18 years ago
Id keyword set as property for all *.f90 files
Property svn:keywords set to `Id`
File size: 11.2 KB

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