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

Last change on this file since 1315 was 1310, checked in by raasch, 11 years ago

update of GPL copyright

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