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

Last change on this file since 1364 was 1360, checked in by hoffmann, 11 years ago

last commit documented

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