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

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

last commit documented

  • Property svn:keywords set to Id
File size: 18.1 KB
RevLine 
[1]1 SUBROUTINE sum_up_3d_data
2
[1036]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!
[1310]17! Copyright 1997-2014 Leibniz Universitaet Hannover
[1036]18!--------------------------------------------------------------------------------!
19!
[484]20! Current revisions:
[1]21! -----------------
22!
[1319]23!
[1]24! Former revisions:
25! -----------------
[3]26! $Id: sum_up_3d_data.f90 1319 2014-03-17 15:08:44Z raasch $
[77]27!
[1319]28! 1318 2014-03-17 13:35:16Z raasch
29! barrier argument removed from cpu_log,
30! module interfaces removed
31!
[1116]32! 1115 2013-03-26 18:16:16Z hoffmann
33! ql is calculated by calc_liquid_water_content
34!
[1054]35! 1053 2012-11-13 17:11:03Z hoffmann
36! +nr, prr, qr
37!
[1037]38! 1036 2012-10-22 13:43:42Z raasch
39! code put under GPL (PALM 3.9)
40!
[1008]41! 1007 2012-09-19 14:30:36Z franke
42! Bugfix in calculation of ql_vp
43!
[979]44! 978 2012-08-09 08:28:32Z fricke
45! +z0h*
46!
[791]47! 790 2011-11-29 03:11:20Z raasch
48! bugfix: calculation of 'pr' must depend on the particle weighting factor
49!
[772]50! 771 2011-10-27 10:56:21Z heinze
51! +lpt_av
52!
[668]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!
[482]56! 402 2009-10-21 11:59:41Z maronga
57! Bugfix in calculation of shf*_av, qsws*_av
58!
[392]59! 2009-08-25 08:35:52Z maronga
60! +shf*, qsws*
61!
[98]62! 96 2007-06-04 08:07:41Z raasch
63! +sum-up of density and salinity
64!
[77]65! 72 2007-03-19 08:20:46Z raasch
66! +sum-up of precipitation rate and roughness length (prr*, z0*)
67!
[3]68! RCS Log replace by Id keyword, revision history cleaned up
69!
[1]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
[667]110                   ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]111                ENDIF
112                e_av = 0.0
113
[771]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
[1]120             CASE ( 'lwp*' )
121                IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
[667]122                   ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
[1]123                ENDIF
124                lwp_av = 0.0
125
[1053]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
[1]132             CASE ( 'p' )
133                IF ( .NOT. ALLOCATED( p_av ) )  THEN
[667]134                   ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]135                ENDIF
136                p_av = 0.0
137
138             CASE ( 'pc' )
139                IF ( .NOT. ALLOCATED( pc_av ) )  THEN
[667]140                   ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]141                ENDIF
142                pc_av = 0.0
143
144             CASE ( 'pr' )
145                IF ( .NOT. ALLOCATED( pr_av ) )  THEN
[667]146                   ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]147                ENDIF
148                pr_av = 0.0
149
[1053]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
[72]156             CASE ( 'prr*' )
157                IF ( .NOT. ALLOCATED( precipitation_rate_av ) )  THEN
[667]158                   ALLOCATE( precipitation_rate_av(nysg:nyng,nxlg:nxrg) )
[72]159                ENDIF
160                precipitation_rate_av = 0.0
161
[1]162             CASE ( 'pt' )
163                IF ( .NOT. ALLOCATED( pt_av ) )  THEN
[667]164                   ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]165                ENDIF
166                pt_av = 0.0
167
168             CASE ( 'q' )
169                IF ( .NOT. ALLOCATED( q_av ) )  THEN
[667]170                   ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]171                ENDIF
172                q_av = 0.0
173
[1115]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
[1]180             CASE ( 'ql' )
181                IF ( .NOT. ALLOCATED( ql_av ) )  THEN
[667]182                   ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]183                ENDIF
184                ql_av = 0.0
185
186             CASE ( 'ql_c' )
187                IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
[667]188                   ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]189                ENDIF
190                ql_c_av = 0.0
191
192             CASE ( 'ql_v' )
193                IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
[667]194                   ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]195                ENDIF
196                ql_v_av = 0.0
197
198             CASE ( 'ql_vp' )
199                IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
[667]200                   ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]201                ENDIF
202                ql_vp_av = 0.0
203
[1053]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
[354]210             CASE ( 'qsws*' )
211                IF ( .NOT. ALLOCATED( qsws_av ) )  THEN
[667]212                   ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
[354]213                ENDIF
214                qsws_av = 0.0
215
[1]216             CASE ( 'qv' )
217                IF ( .NOT. ALLOCATED( qv_av ) )  THEN
[667]218                   ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]219                ENDIF
220                qv_av = 0.0
221
[96]222             CASE ( 'rho' )
223                IF ( .NOT. ALLOCATED( rho_av ) )  THEN
[667]224                   ALLOCATE( rho_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[96]225                ENDIF
226                rho_av = 0.0
227
[1]228             CASE ( 's' )
229                IF ( .NOT. ALLOCATED( s_av ) )  THEN
[667]230                   ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]231                ENDIF
232                s_av = 0.0
233
[96]234             CASE ( 'sa' )
235                IF ( .NOT. ALLOCATED( sa_av ) )  THEN
[667]236                   ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[96]237                ENDIF
238                sa_av = 0.0
239
[354]240             CASE ( 'shf*' )
241                IF ( .NOT. ALLOCATED( shf_av ) )  THEN
[667]242                   ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
[354]243                ENDIF
244                shf_av = 0.0
245
[1]246             CASE ( 't*' )
247                IF ( .NOT. ALLOCATED( ts_av ) )  THEN
[667]248                   ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
[1]249                ENDIF
250                ts_av = 0.0
251
252             CASE ( 'u' )
253                IF ( .NOT. ALLOCATED( u_av ) )  THEN
[667]254                   ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]255                ENDIF
256                u_av = 0.0
257
258             CASE ( 'u*' )
259                IF ( .NOT. ALLOCATED( us_av ) )  THEN
[667]260                   ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
[1]261                ENDIF
262                us_av = 0.0
263
264             CASE ( 'v' )
265                IF ( .NOT. ALLOCATED( v_av ) )  THEN
[667]266                   ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]267                ENDIF
268                v_av = 0.0
269
270             CASE ( 'vpt' )
271                IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
[667]272                   ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]273                ENDIF
274                vpt_av = 0.0
275
276             CASE ( 'w' )
277                IF ( .NOT. ALLOCATED( w_av ) )  THEN
[667]278                   ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]279                ENDIF
280                w_av = 0.0
281
[72]282             CASE ( 'z0*' )
283                IF ( .NOT. ALLOCATED( z0_av ) )  THEN
[667]284                   ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
[72]285                ENDIF
286                z0_av = 0.0
287
[978]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
[1]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' )
[667]314             DO  i = nxlg, nxrg
315                DO  j = nysg, nyng
[1]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
[771]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
[1]331          CASE ( 'lwp*' )
[667]332             DO  i = nxlg, nxrg
333                DO  j = nysg, nyng
[1]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
[1053]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
[1]348          CASE ( 'p' )
[667]349             DO  i = nxlg, nxrg
350                DO  j = nysg, nyng
[1]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
[790]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
[1]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
[72]389          CASE ( 'pr*' )
[667]390             DO  i = nxlg, nxrg
391                DO  j = nysg, nyng
[72]392                   precipitation_rate_av(j,i) = precipitation_rate_av(j,i) + &
393                                                precipitation_rate(j,i)
394                ENDDO
395             ENDDO
396
[1]397          CASE ( 'pt' )
398             IF ( .NOT. cloud_physics ) THEN
[667]399             DO  i = nxlg, nxrg
400                DO  j = nysg, nyng
401                   DO  k = nzb, nzt+1
[1]402                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
403                      ENDDO
404                   ENDDO
405                ENDDO
406             ELSE
[667]407             DO  i = nxlg, nxrg
408                DO  j = nysg, nyng
409                   DO  k = nzb, nzt+1
[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' )
[667]418             DO  i = nxlg, nxrg
419                DO  j = nysg, nyng
[1]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
[402]425
[1115]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
[1]435          CASE ( 'ql' )
[667]436             DO  i = nxlg, nxrg
437                DO  j = nysg, nyng
[1]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' )
[667]445             DO  i = nxlg, nxrg
446                DO  j = nysg, nyng
[1]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' )
[667]454             DO  i = nxlg, nxrg
455                DO  j = nysg, nyng
[1]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' )
[1007]463             DO  i = nxl, nxr
464                DO  j = nys, nyn
[1]465                   DO  k = nzb, nzt+1
[1007]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
[1]472                   ENDDO
473                ENDDO
474             ENDDO
475
[1053]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
[402]485          CASE ( 'qsws*' )
[667]486             DO  i = nxlg, nxrg
487                DO  j = nysg, nyng
[402]488                   qsws_av(j,i) = qsws_av(j,i) + qsws(j,i)
489                ENDDO
490             ENDDO
491
[1]492          CASE ( 'qv' )
[667]493             DO  i = nxlg, nxrg
494                DO  j = nysg, nyng
[1]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
[96]501          CASE ( 'rho' )
[667]502             DO  i = nxlg, nxrg
503                DO  j = nysg, nyng
[96]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
[402]509
[1]510          CASE ( 's' )
[667]511             DO  i = nxlg, nxrg
512                DO  j = nysg, nyng
[1]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
[402]518
[96]519          CASE ( 'sa' )
[667]520             DO  i = nxlg, nxrg
521                DO  j = nysg, nyng
[96]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
[402]527
528          CASE ( 'shf*' )
[667]529             DO  i = nxlg, nxrg
530                DO  j = nysg, nyng
[402]531                   shf_av(j,i) = shf_av(j,i) + shf(j,i)
532                ENDDO
533             ENDDO
534
[1]535          CASE ( 't*' )
[667]536             DO  i = nxlg, nxrg
537                DO  j = nysg, nyng
[1]538                   ts_av(j,i) = ts_av(j,i) + ts(j,i)
539                ENDDO
540             ENDDO
541
542          CASE ( 'u' )
[667]543             DO  i = nxlg, nxrg
544                DO  j = nysg, nyng
[1]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*' )
[667]552             DO  i = nxlg, nxrg
553                DO  j = nysg, nyng
[1]554                   us_av(j,i) = us_av(j,i) + us(j,i)
555                ENDDO
556             ENDDO
557
558          CASE ( 'v' )
[667]559             DO  i = nxlg, nxrg
560                DO  j = nysg, nyng
[1]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' )
[667]568             DO  i = nxlg, nxrg
569                DO  j = nysg, nyng
[1]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' )
[667]577             DO  i = nxlg, nxrg
578                DO  j = nysg, nyng
[1]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
[72]585          CASE ( 'z0*' )
[667]586             DO  i = nxlg, nxrg
587                DO  j = nysg, nyng
[72]588                   z0_av(j,i) = z0_av(j,i) + z0(j,i)
589                ENDDO
590             ENDDO
591
[978]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
[1]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
[1318]608    CALL cpu_log( log_point(34), 'sum_up_3d_data', 'stop' )
[1]609
610
611 END SUBROUTINE sum_up_3d_data
Note: See TracBrowser for help on using the repository browser.