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

Last change on this file since 1319 was 1319, checked in by raasch, 8 years ago

last commit documented

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