source: palm/tags/release-3.8/SOURCE/sum_up_3d_data.f90 @ 4343

Last change on this file since 4343 was 668, checked in by suehring, 11 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 14.0 KB
Line 
1 SUBROUTINE sum_up_3d_data
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7! Former revisions:
8! -----------------
9! $Id: sum_up_3d_data.f90 668 2010-12-23 13:22:58Z oliver.maas $
10!
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!
14! 402 2009-10-21 11:59:41Z maronga
15! Bugfix in calculation of shf*_av, qsws*_av
16!
17! 2009-08-25 08:35:52Z maronga
18! +shf*, qsws*
19!
20! 96 2007-06-04 08:07:41Z raasch
21! +sum-up of density and salinity
22!
23! 72 2007-03-19 08:20:46Z raasch
24! +sum-up of precipitation rate and roughness length (prr*, z0*)
25!
26! RCS Log replace by Id keyword, revision history cleaned up
27!
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
69                   ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
70                ENDIF
71                e_av = 0.0
72
73             CASE ( 'lwp*' )
74                IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
75                   ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
76                ENDIF
77                lwp_av = 0.0
78
79             CASE ( 'p' )
80                IF ( .NOT. ALLOCATED( p_av ) )  THEN
81                   ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
82                ENDIF
83                p_av = 0.0
84
85             CASE ( 'pc' )
86                IF ( .NOT. ALLOCATED( pc_av ) )  THEN
87                   ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
88                ENDIF
89                pc_av = 0.0
90
91             CASE ( 'pr' )
92                IF ( .NOT. ALLOCATED( pr_av ) )  THEN
93                   ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
94                ENDIF
95                pr_av = 0.0
96
97             CASE ( 'prr*' )
98                IF ( .NOT. ALLOCATED( precipitation_rate_av ) )  THEN
99                   ALLOCATE( precipitation_rate_av(nysg:nyng,nxlg:nxrg) )
100                ENDIF
101                precipitation_rate_av = 0.0
102
103             CASE ( 'pt' )
104                IF ( .NOT. ALLOCATED( pt_av ) )  THEN
105                   ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
106                ENDIF
107                pt_av = 0.0
108
109             CASE ( 'q' )
110                IF ( .NOT. ALLOCATED( q_av ) )  THEN
111                   ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
112                ENDIF
113                q_av = 0.0
114
115             CASE ( 'ql' )
116                IF ( .NOT. ALLOCATED( ql_av ) )  THEN
117                   ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
118                ENDIF
119                ql_av = 0.0
120
121             CASE ( 'ql_c' )
122                IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
123                   ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
124                ENDIF
125                ql_c_av = 0.0
126
127             CASE ( 'ql_v' )
128                IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
129                   ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
130                ENDIF
131                ql_v_av = 0.0
132
133             CASE ( 'ql_vp' )
134                IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
135                   ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
136                ENDIF
137                ql_vp_av = 0.0
138
139             CASE ( 'qsws*' )
140                IF ( .NOT. ALLOCATED( qsws_av ) )  THEN
141                   ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
142                ENDIF
143                qsws_av = 0.0
144
145             CASE ( 'qv' )
146                IF ( .NOT. ALLOCATED( qv_av ) )  THEN
147                   ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
148                ENDIF
149                qv_av = 0.0
150
151             CASE ( 'rho' )
152                IF ( .NOT. ALLOCATED( rho_av ) )  THEN
153                   ALLOCATE( rho_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
154                ENDIF
155                rho_av = 0.0
156
157             CASE ( 's' )
158                IF ( .NOT. ALLOCATED( s_av ) )  THEN
159                   ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
160                ENDIF
161                s_av = 0.0
162
163             CASE ( 'sa' )
164                IF ( .NOT. ALLOCATED( sa_av ) )  THEN
165                   ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
166                ENDIF
167                sa_av = 0.0
168
169             CASE ( 'shf*' )
170                IF ( .NOT. ALLOCATED( shf_av ) )  THEN
171                   ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
172                ENDIF
173                shf_av = 0.0
174
175             CASE ( 't*' )
176                IF ( .NOT. ALLOCATED( ts_av ) )  THEN
177                   ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
178                ENDIF
179                ts_av = 0.0
180
181             CASE ( 'u' )
182                IF ( .NOT. ALLOCATED( u_av ) )  THEN
183                   ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
184                ENDIF
185                u_av = 0.0
186
187             CASE ( 'u*' )
188                IF ( .NOT. ALLOCATED( us_av ) )  THEN
189                   ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
190                ENDIF
191                us_av = 0.0
192
193             CASE ( 'v' )
194                IF ( .NOT. ALLOCATED( v_av ) )  THEN
195                   ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
196                ENDIF
197                v_av = 0.0
198
199             CASE ( 'vpt' )
200                IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
201                   ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
202                ENDIF
203                vpt_av = 0.0
204
205             CASE ( 'w' )
206                IF ( .NOT. ALLOCATED( w_av ) )  THEN
207                   ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
208                ENDIF
209                w_av = 0.0
210
211             CASE ( 'z0*' )
212                IF ( .NOT. ALLOCATED( z0_av ) )  THEN
213                   ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
214                ENDIF
215                z0_av = 0.0
216
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' )
237             DO  i = nxlg, nxrg
238                DO  j = nysg, nyng
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*' )
246             DO  i = nxlg, nxrg
247                DO  j = nysg, nyng
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' )
254             DO  i = nxlg, nxrg
255                DO  j = nysg, nyng
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
292          CASE ( 'pr*' )
293             DO  i = nxlg, nxrg
294                DO  j = nysg, nyng
295                   precipitation_rate_av(j,i) = precipitation_rate_av(j,i) + &
296                                                precipitation_rate(j,i)
297                ENDDO
298             ENDDO
299
300          CASE ( 'pt' )
301             IF ( .NOT. cloud_physics ) THEN
302             DO  i = nxlg, nxrg
303                DO  j = nysg, nyng
304                   DO  k = nzb, nzt+1
305                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
306                      ENDDO
307                   ENDDO
308                ENDDO
309             ELSE
310             DO  i = nxlg, nxrg
311                DO  j = nysg, nyng
312                   DO  k = nzb, nzt+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' )
321             DO  i = nxlg, nxrg
322                DO  j = nysg, nyng
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
328
329          CASE ( 'ql' )
330             DO  i = nxlg, nxrg
331                DO  j = nysg, nyng
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' )
339             DO  i = nxlg, nxrg
340                DO  j = nysg, nyng
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' )
348             DO  i = nxlg, nxrg
349                DO  j = nysg, nyng
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' )
357             DO  i = nxlg, nxrg
358                DO  j = nysg, nyng
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
365          CASE ( 'qsws*' )
366             DO  i = nxlg, nxrg
367                DO  j = nysg, nyng
368                   qsws_av(j,i) = qsws_av(j,i) + qsws(j,i)
369                ENDDO
370             ENDDO
371
372          CASE ( 'qv' )
373             DO  i = nxlg, nxrg
374                DO  j = nysg, nyng
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
381          CASE ( 'rho' )
382             DO  i = nxlg, nxrg
383                DO  j = nysg, nyng
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
389
390          CASE ( 's' )
391             DO  i = nxlg, nxrg
392                DO  j = nysg, nyng
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
398
399          CASE ( 'sa' )
400             DO  i = nxlg, nxrg
401                DO  j = nysg, nyng
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
407
408          CASE ( 'shf*' )
409             DO  i = nxlg, nxrg
410                DO  j = nysg, nyng
411                   shf_av(j,i) = shf_av(j,i) + shf(j,i)
412                ENDDO
413             ENDDO
414
415          CASE ( 't*' )
416             DO  i = nxlg, nxrg
417                DO  j = nysg, nyng
418                   ts_av(j,i) = ts_av(j,i) + ts(j,i)
419                ENDDO
420             ENDDO
421
422          CASE ( 'u' )
423             DO  i = nxlg, nxrg
424                DO  j = nysg, nyng
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*' )
432             DO  i = nxlg, nxrg
433                DO  j = nysg, nyng
434                   us_av(j,i) = us_av(j,i) + us(j,i)
435                ENDDO
436             ENDDO
437
438          CASE ( 'v' )
439             DO  i = nxlg, nxrg
440                DO  j = nysg, nyng
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' )
448             DO  i = nxlg, nxrg
449                DO  j = nysg, nyng
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' )
457             DO  i = nxlg, nxrg
458                DO  j = nysg, nyng
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
465          CASE ( 'z0*' )
466             DO  i = nxlg, nxrg
467                DO  j = nysg, nyng
468                   z0_av(j,i) = z0_av(j,i) + z0(j,i)
469                ENDDO
470             ENDDO
471
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.