Home

Context Navigation

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

Last change on this file since 1115 was 1115, checked in by hoffmann, 12 years ago
optimization of two-moments cloud physics
Property svn:keywords set to `Id`
File size: 17.9 KB

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