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

Last change on this file since 789 was 772, checked in by heinze, 13 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 14.5 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 772 2011-10-27 11:08:46Z raasch $
10!
11! 771 2011-10-27 10:56:21Z heinze
12! +lpt_av
13!
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!
17! 402 2009-10-21 11:59:41Z maronga
18! Bugfix in calculation of shf*_av, qsws*_av
19!
20! 2009-08-25 08:35:52Z maronga
21! +shf*, qsws*
22!
23! 96 2007-06-04 08:07:41Z raasch
24! +sum-up of density and salinity
25!
26! 72 2007-03-19 08:20:46Z raasch
27! +sum-up of precipitation rate and roughness length (prr*, z0*)
28!
29! RCS Log replace by Id keyword, revision history cleaned up
30!
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
72                   ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
73                ENDIF
74                e_av = 0.0
75
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
82             CASE ( 'lwp*' )
83                IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
84                   ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
85                ENDIF
86                lwp_av = 0.0
87
88             CASE ( 'p' )
89                IF ( .NOT. ALLOCATED( p_av ) )  THEN
90                   ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
91                ENDIF
92                p_av = 0.0
93
94             CASE ( 'pc' )
95                IF ( .NOT. ALLOCATED( pc_av ) )  THEN
96                   ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
97                ENDIF
98                pc_av = 0.0
99
100             CASE ( 'pr' )
101                IF ( .NOT. ALLOCATED( pr_av ) )  THEN
102                   ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
103                ENDIF
104                pr_av = 0.0
105
106             CASE ( 'prr*' )
107                IF ( .NOT. ALLOCATED( precipitation_rate_av ) )  THEN
108                   ALLOCATE( precipitation_rate_av(nysg:nyng,nxlg:nxrg) )
109                ENDIF
110                precipitation_rate_av = 0.0
111
112             CASE ( 'pt' )
113                IF ( .NOT. ALLOCATED( pt_av ) )  THEN
114                   ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
115                ENDIF
116                pt_av = 0.0
117
118             CASE ( 'q' )
119                IF ( .NOT. ALLOCATED( q_av ) )  THEN
120                   ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
121                ENDIF
122                q_av = 0.0
123
124             CASE ( 'ql' )
125                IF ( .NOT. ALLOCATED( ql_av ) )  THEN
126                   ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
127                ENDIF
128                ql_av = 0.0
129
130             CASE ( 'ql_c' )
131                IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
132                   ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
133                ENDIF
134                ql_c_av = 0.0
135
136             CASE ( 'ql_v' )
137                IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
138                   ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
139                ENDIF
140                ql_v_av = 0.0
141
142             CASE ( 'ql_vp' )
143                IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
144                   ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
145                ENDIF
146                ql_vp_av = 0.0
147
148             CASE ( 'qsws*' )
149                IF ( .NOT. ALLOCATED( qsws_av ) )  THEN
150                   ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
151                ENDIF
152                qsws_av = 0.0
153
154             CASE ( 'qv' )
155                IF ( .NOT. ALLOCATED( qv_av ) )  THEN
156                   ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
157                ENDIF
158                qv_av = 0.0
159
160             CASE ( 'rho' )
161                IF ( .NOT. ALLOCATED( rho_av ) )  THEN
162                   ALLOCATE( rho_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
163                ENDIF
164                rho_av = 0.0
165
166             CASE ( 's' )
167                IF ( .NOT. ALLOCATED( s_av ) )  THEN
168                   ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
169                ENDIF
170                s_av = 0.0
171
172             CASE ( 'sa' )
173                IF ( .NOT. ALLOCATED( sa_av ) )  THEN
174                   ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
175                ENDIF
176                sa_av = 0.0
177
178             CASE ( 'shf*' )
179                IF ( .NOT. ALLOCATED( shf_av ) )  THEN
180                   ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
181                ENDIF
182                shf_av = 0.0
183
184             CASE ( 't*' )
185                IF ( .NOT. ALLOCATED( ts_av ) )  THEN
186                   ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
187                ENDIF
188                ts_av = 0.0
189
190             CASE ( 'u' )
191                IF ( .NOT. ALLOCATED( u_av ) )  THEN
192                   ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
193                ENDIF
194                u_av = 0.0
195
196             CASE ( 'u*' )
197                IF ( .NOT. ALLOCATED( us_av ) )  THEN
198                   ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
199                ENDIF
200                us_av = 0.0
201
202             CASE ( 'v' )
203                IF ( .NOT. ALLOCATED( v_av ) )  THEN
204                   ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
205                ENDIF
206                v_av = 0.0
207
208             CASE ( 'vpt' )
209                IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
210                   ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
211                ENDIF
212                vpt_av = 0.0
213
214             CASE ( 'w' )
215                IF ( .NOT. ALLOCATED( w_av ) )  THEN
216                   ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
217                ENDIF
218                w_av = 0.0
219
220             CASE ( 'z0*' )
221                IF ( .NOT. ALLOCATED( z0_av ) )  THEN
222                   ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
223                ENDIF
224                z0_av = 0.0
225
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' )
246             DO  i = nxlg, nxrg
247                DO  j = nysg, nyng
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
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
263          CASE ( 'lwp*' )
264             DO  i = nxlg, nxrg
265                DO  j = nysg, nyng
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' )
272             DO  i = nxlg, nxrg
273                DO  j = nysg, nyng
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
310          CASE ( 'pr*' )
311             DO  i = nxlg, nxrg
312                DO  j = nysg, nyng
313                   precipitation_rate_av(j,i) = precipitation_rate_av(j,i) + &
314                                                precipitation_rate(j,i)
315                ENDDO
316             ENDDO
317
318          CASE ( 'pt' )
319             IF ( .NOT. cloud_physics ) THEN
320             DO  i = nxlg, nxrg
321                DO  j = nysg, nyng
322                   DO  k = nzb, nzt+1
323                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
324                      ENDDO
325                   ENDDO
326                ENDDO
327             ELSE
328             DO  i = nxlg, nxrg
329                DO  j = nysg, nyng
330                   DO  k = nzb, nzt+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' )
339             DO  i = nxlg, nxrg
340                DO  j = nysg, nyng
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
346
347          CASE ( 'ql' )
348             DO  i = nxlg, nxrg
349                DO  j = nysg, nyng
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' )
357             DO  i = nxlg, nxrg
358                DO  j = nysg, nyng
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' )
366             DO  i = nxlg, nxrg
367                DO  j = nysg, nyng
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' )
375             DO  i = nxlg, nxrg
376                DO  j = nysg, nyng
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
383          CASE ( 'qsws*' )
384             DO  i = nxlg, nxrg
385                DO  j = nysg, nyng
386                   qsws_av(j,i) = qsws_av(j,i) + qsws(j,i)
387                ENDDO
388             ENDDO
389
390          CASE ( 'qv' )
391             DO  i = nxlg, nxrg
392                DO  j = nysg, nyng
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
399          CASE ( 'rho' )
400             DO  i = nxlg, nxrg
401                DO  j = nysg, nyng
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
407
408          CASE ( 's' )
409             DO  i = nxlg, nxrg
410                DO  j = nysg, nyng
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
416
417          CASE ( 'sa' )
418             DO  i = nxlg, nxrg
419                DO  j = nysg, nyng
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
425
426          CASE ( 'shf*' )
427             DO  i = nxlg, nxrg
428                DO  j = nysg, nyng
429                   shf_av(j,i) = shf_av(j,i) + shf(j,i)
430                ENDDO
431             ENDDO
432
433          CASE ( 't*' )
434             DO  i = nxlg, nxrg
435                DO  j = nysg, nyng
436                   ts_av(j,i) = ts_av(j,i) + ts(j,i)
437                ENDDO
438             ENDDO
439
440          CASE ( 'u' )
441             DO  i = nxlg, nxrg
442                DO  j = nysg, nyng
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*' )
450             DO  i = nxlg, nxrg
451                DO  j = nysg, nyng
452                   us_av(j,i) = us_av(j,i) + us(j,i)
453                ENDDO
454             ENDDO
455
456          CASE ( 'v' )
457             DO  i = nxlg, nxrg
458                DO  j = nysg, nyng
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' )
466             DO  i = nxlg, nxrg
467                DO  j = nysg, nyng
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' )
475             DO  i = nxlg, nxrg
476                DO  j = nysg, nyng
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
483          CASE ( 'z0*' )
484             DO  i = nxlg, nxrg
485                DO  j = nysg, nyng
486                   z0_av(j,i) = z0_av(j,i) + z0(j,i)
487                ENDDO
488             ENDDO
489
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.