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

Last change on this file since 1972 was 1972, checked in by maronga, 8 years ago

further modularization of land surface model (2D/3D output and restart data)

  • Property svn:keywords set to Id
File size: 27.3 KB
Line 
1!> @file sum_up_3d_data.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms
6! of the GNU General Public License as published by the Free Software Foundation,
7! either version 3 of the License, or (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
10! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with
14! PALM. If not, see <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2016 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21! Land surface actions are now done directly in the respective module
22!
23! Former revisions:
24! -----------------
25! $Id: sum_up_3d_data.f90 1972 2016-07-26 07:52:02Z maronga $
26!
27! 1960 2016-07-12 16:34:24Z suehring
28! Scalar surface flux added
29!
30! 1949 2016-06-17 07:19:16Z maronga
31! Bugfix: calculation of lai_av, c_veg_av and c_liq_av.
32!
33! 1849 2016-04-08 11:33:18Z hoffmann
34! precipitation_rate moved to arrays_3d
35!
36! 1788 2016-03-10 11:01:04Z maronga
37! Added z0q and z0q_av
38!
39! 1693 2015-10-27 08:35:45Z maronga
40! Last revision text corrected
41!
42! 1691 2015-10-26 16:17:44Z maronga
43! Added output of Obukhov length and radiative heating rates for RRTMG.
44! Corrected output of liquid water path.
45!
46! 1682 2015-10-07 23:56:08Z knoop
47! Code annotations made doxygen readable
48!
49! 1585 2015-04-30 07:05:52Z maronga
50! Adapted for RRTMG
51!
52! 1555 2015-03-04 17:44:27Z maronga
53! Added output of r_a and r_s
54!
55! 1551 2015-03-03 14:18:16Z maronga
56! Added support for land surface model and radiation model data.
57!
58! 1359 2014-04-11 17:15:14Z hoffmann
59! New particle structure integrated.
60!
61! 1353 2014-04-08 15:21:23Z heinze
62! REAL constants provided with KIND-attribute
63!
64! 1320 2014-03-20 08:40:49Z raasch
65! ONLY-attribute added to USE-statements,
66! kind-parameters added to all INTEGER and REAL declaration statements,
67! kinds are defined in new module kinds,
68! old module precision_kind is removed,
69! revision history before 2012 removed,
70! comment fields (!:) to be used for variable explanations added to
71! all variable declaration statements
72!
73! 1318 2014-03-17 13:35:16Z raasch
74! barrier argument removed from cpu_log,
75! module interfaces removed
76!
77! 1115 2013-03-26 18:16:16Z hoffmann
78! ql is calculated by calc_liquid_water_content
79!
80! 1053 2012-11-13 17:11:03Z hoffmann
81! +nr, prr, qr
82!
83! 1036 2012-10-22 13:43:42Z raasch
84! code put under GPL (PALM 3.9)
85!
86! 1007 2012-09-19 14:30:36Z franke
87! Bugfix in calculation of ql_vp
88!
89! 978 2012-08-09 08:28:32Z fricke
90! +z0h*
91!
92! Revision 1.1  2006/02/23 12:55:23  raasch
93! Initial revision
94!
95!
96! Description:
97! ------------
98!> Sum-up the values of 3d-arrays. The real averaging is later done in routine
99!> average_3d_data.
100!------------------------------------------------------------------------------!
101 SUBROUTINE sum_up_3d_data
102 
103
104    USE arrays_3d,                                                             &
105        ONLY:  dzw, e, nr, ol, p, pt, precipitation_rate, q, qc, ql, ql_c,     &
106               ql_v, qr, qsws, rho, sa, shf, ssws, ts, u, us, v, vpt, w, z0,   &
107               z0h, z0q
108
109    USE averaging,                                                             &
110        ONLY:  e_av, lpt_av, lwp_av, nr_av, ol_av, p_av, pc_av, pr_av, prr_av, &
111               precipitation_rate_av, pt_av, q_av, qc_av, ql_av, ql_c_av,      &
112               ql_v_av, ql_vp_av, qr_av, qsws_av, qv_av, rho_av, s_av, sa_av,  &
113               shf_av, ssws_av, ts_av, u_av, us_av, v_av, vpt_av, w_av, z0_av, &
114               z0h_av, z0q_av
115
116    USE cloud_parameters,                                                      &
117        ONLY:  l_d_cp, pt_d_t
118
119    USE control_parameters,                                                    &
120        ONLY:  average_count_3d, cloud_physics, doav, doav_n, rho_surface
121
122    USE cpulog,                                                                &
123        ONLY:  cpu_log, log_point
124
125    USE indices,                                                               &
126        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt 
127
128    USE kinds
129
130    USE land_surface_model_mod,                                                &
131        ONLY:  land_surface, lsm_3d_data_averaging
132
133    USE particle_attributes,                                                   &
134        ONLY:  grid_particles, number_of_particles, particles, prt_count
135
136    USE radiation_model_mod,                                                   &
137        ONLY:  rad_net, rad_net_av, rad_sw_in, rad_sw_in_av, rad_sw_out,       &
138               rad_sw_out_av, rad_sw_cs_hr, rad_sw_cs_hr_av, rad_sw_hr,        &
139               rad_sw_hr_av, rad_lw_in, rad_lw_in_av, rad_lw_out,              &
140               rad_lw_out_av, rad_lw_cs_hr, rad_lw_cs_hr_av, rad_lw_hr,        &
141               rad_lw_hr_av
142
143
144    IMPLICIT NONE
145
146    INTEGER(iwp) ::  i   !<
147    INTEGER(iwp) ::  ii  !<
148    INTEGER(iwp) ::  j   !<
149    INTEGER(iwp) ::  k   !<
150    INTEGER(iwp) ::  n   !<
151    INTEGER(iwp) ::  psi !<
152
153    REAL(wp)     ::  mean_r !<
154    REAL(wp)     ::  s_r2   !<
155    REAL(wp)     ::  s_r3   !<
156
157    CALL cpu_log (log_point(34),'sum_up_3d_data','start')
158
159!
160!-- Allocate and initialize the summation arrays if called for the very first
161!-- time or the first time after average_3d_data has been called
162!-- (some or all of the arrays may have been already allocated
163!-- in read_3d_binary)
164    IF ( average_count_3d == 0 )  THEN
165
166       DO  ii = 1, doav_n
167
168          SELECT CASE ( TRIM( doav(ii) ) )
169
170             CASE ( 'e' )
171                IF ( .NOT. ALLOCATED( e_av ) )  THEN
172                   ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
173                ENDIF
174                e_av = 0.0_wp
175
176             CASE ( 'lpt' )
177                IF ( .NOT. ALLOCATED( lpt_av ) )  THEN
178                   ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
179                ENDIF
180                lpt_av = 0.0_wp
181
182             CASE ( 'lwp*' )
183                IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
184                   ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
185                ENDIF
186                lwp_av = 0.0_wp
187
188             CASE ( 'nr' )
189                IF ( .NOT. ALLOCATED( nr_av ) )  THEN
190                   ALLOCATE( nr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
191                ENDIF
192                nr_av = 0.0_wp
193
194             CASE ( 'ol*' )
195                IF ( .NOT. ALLOCATED( ol_av ) )  THEN
196                   ALLOCATE( ol_av(nysg:nyng,nxlg:nxrg) )
197                ENDIF
198                ol_av = 0.0_wp
199
200             CASE ( 'p' )
201                IF ( .NOT. ALLOCATED( p_av ) )  THEN
202                   ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
203                ENDIF
204                p_av = 0.0_wp
205
206             CASE ( 'pc' )
207                IF ( .NOT. ALLOCATED( pc_av ) )  THEN
208                   ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
209                ENDIF
210                pc_av = 0.0_wp
211
212             CASE ( 'pr' )
213                IF ( .NOT. ALLOCATED( pr_av ) )  THEN
214                   ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
215                ENDIF
216                pr_av = 0.0_wp
217
218             CASE ( 'prr' )
219                IF ( .NOT. ALLOCATED( prr_av ) )  THEN
220                   ALLOCATE( prr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
221                ENDIF
222                prr_av = 0.0_wp
223
224             CASE ( 'prr*' )
225                IF ( .NOT. ALLOCATED( precipitation_rate_av ) )  THEN
226                   ALLOCATE( precipitation_rate_av(nysg:nyng,nxlg:nxrg) )
227                ENDIF
228                precipitation_rate_av = 0.0_wp
229
230             CASE ( 'pt' )
231                IF ( .NOT. ALLOCATED( pt_av ) )  THEN
232                   ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
233                ENDIF
234                pt_av = 0.0_wp
235
236             CASE ( 'q' )
237                IF ( .NOT. ALLOCATED( q_av ) )  THEN
238                   ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
239                ENDIF
240                q_av = 0.0_wp
241
242             CASE ( 'qc' )
243                IF ( .NOT. ALLOCATED( qc_av ) )  THEN
244                   ALLOCATE( qc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
245                ENDIF
246                qc_av = 0.0_wp
247
248             CASE ( 'ql' )
249                IF ( .NOT. ALLOCATED( ql_av ) )  THEN
250                   ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
251                ENDIF
252                ql_av = 0.0_wp
253
254             CASE ( 'ql_c' )
255                IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
256                   ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
257                ENDIF
258                ql_c_av = 0.0_wp
259
260             CASE ( 'ql_v' )
261                IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
262                   ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
263                ENDIF
264                ql_v_av = 0.0_wp
265
266             CASE ( 'ql_vp' )
267                IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
268                   ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
269                ENDIF
270                ql_vp_av = 0.0_wp
271
272             CASE ( 'qr' )
273                IF ( .NOT. ALLOCATED( qr_av ) )  THEN
274                   ALLOCATE( qr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
275                ENDIF
276                qr_av = 0.0_wp
277
278             CASE ( 'qsws*' )
279                IF ( .NOT. ALLOCATED( qsws_av ) )  THEN
280                   ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
281                ENDIF
282                qsws_av = 0.0_wp
283
284             CASE ( 'qv' )
285                IF ( .NOT. ALLOCATED( qv_av ) )  THEN
286                   ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
287                ENDIF
288                qv_av = 0.0_wp
289
290             CASE ( 'rad_net*' )
291                IF ( .NOT. ALLOCATED( rad_net_av ) )  THEN
292                   ALLOCATE( rad_net_av(nysg:nyng,nxlg:nxrg) )
293                ENDIF
294                rad_net_av = 0.0_wp
295
296             CASE ( 'rad_lw_in' )
297                IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  THEN
298                   ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
299                ENDIF
300                rad_lw_in_av = 0.0_wp
301
302             CASE ( 'rad_lw_out' )
303                IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  THEN
304                   ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
305                ENDIF
306                rad_lw_out_av = 0.0_wp
307
308             CASE ( 'rad_lw_cs_hr' )
309                IF ( .NOT. ALLOCATED( rad_lw_cs_hr_av ) )  THEN
310                   ALLOCATE( rad_lw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
311                ENDIF
312                rad_lw_cs_hr_av = 0.0_wp
313
314             CASE ( 'rad_lw_hr' )
315                IF ( .NOT. ALLOCATED( rad_lw_hr_av ) )  THEN
316                   ALLOCATE( rad_lw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
317                ENDIF
318                rad_lw_hr_av = 0.0_wp
319
320             CASE ( 'rad_sw_in' )
321                IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  THEN
322                   ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
323                ENDIF
324                rad_sw_in_av = 0.0_wp
325
326             CASE ( 'rad_sw_out' )
327                IF ( .NOT. ALLOCATED( rad_sw_out_av ) )  THEN
328                   ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
329                ENDIF
330                rad_sw_out_av = 0.0_wp
331
332             CASE ( 'rad_sw_cs_hr' )
333                IF ( .NOT. ALLOCATED( rad_sw_cs_hr_av ) )  THEN
334                   ALLOCATE( rad_sw_cs_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
335                ENDIF
336                rad_sw_cs_hr_av = 0.0_wp
337
338             CASE ( 'rad_sw_hr' )
339                IF ( .NOT. ALLOCATED( rad_sw_hr_av ) )  THEN
340                   ALLOCATE( rad_sw_hr_av(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
341                ENDIF
342                rad_sw_hr_av = 0.0_wp
343
344             CASE ( 'rho' )
345                IF ( .NOT. ALLOCATED( rho_av ) )  THEN
346                   ALLOCATE( rho_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
347                ENDIF
348                rho_av = 0.0_wp
349
350             CASE ( 's' )
351                IF ( .NOT. ALLOCATED( s_av ) )  THEN
352                   ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
353                ENDIF
354                s_av = 0.0_wp
355
356             CASE ( 'sa' )
357                IF ( .NOT. ALLOCATED( sa_av ) )  THEN
358                   ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
359                ENDIF
360                sa_av = 0.0_wp
361
362             CASE ( 'shf*' )
363                IF ( .NOT. ALLOCATED( shf_av ) )  THEN
364                   ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
365                ENDIF
366                shf_av = 0.0_wp
367
368             CASE ( 't*' )
369                IF ( .NOT. ALLOCATED( ts_av ) )  THEN
370                   ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
371                ENDIF
372                ts_av = 0.0_wp
373
374             CASE ( 'u' )
375                IF ( .NOT. ALLOCATED( u_av ) )  THEN
376                   ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
377                ENDIF
378                u_av = 0.0_wp
379
380             CASE ( 'u*' )
381                IF ( .NOT. ALLOCATED( us_av ) )  THEN
382                   ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
383                ENDIF
384                us_av = 0.0_wp
385
386             CASE ( 'v' )
387                IF ( .NOT. ALLOCATED( v_av ) )  THEN
388                   ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
389                ENDIF
390                v_av = 0.0_wp
391
392             CASE ( 'vpt' )
393                IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
394                   ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
395                ENDIF
396                vpt_av = 0.0_wp
397
398             CASE ( 'w' )
399                IF ( .NOT. ALLOCATED( w_av ) )  THEN
400                   ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
401                ENDIF
402                w_av = 0.0_wp
403
404             CASE ( 'z0*' )
405                IF ( .NOT. ALLOCATED( z0_av ) )  THEN
406                   ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
407                ENDIF
408                z0_av = 0.0_wp
409
410             CASE ( 'z0h*' )
411                IF ( .NOT. ALLOCATED( z0h_av ) )  THEN
412                   ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
413                ENDIF
414                z0h_av = 0.0_wp
415
416             CASE ( 'z0q*' )
417                IF ( .NOT. ALLOCATED( z0q_av ) )  THEN
418                   ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
419                ENDIF
420                z0q_av = 0.0_wp
421
422             CASE DEFAULT
423
424!
425!--             Land surface quantity
426                IF ( land_surface )  THEN
427                   CALL lsm_3d_data_averaging( 'allocate', doav(ii) )
428                ENDIF
429
430!
431!--             User-defined quantity
432                CALL user_3d_data_averaging( 'allocate', doav(ii) )
433
434          END SELECT
435
436       ENDDO
437
438    ENDIF
439
440!
441!-- Loop of all variables to be averaged.
442    DO  ii = 1, doav_n
443
444!
445!--    Store the array chosen on the temporary array.
446       SELECT CASE ( TRIM( doav(ii) ) )
447
448          CASE ( 'e' )
449             DO  i = nxlg, nxrg
450                DO  j = nysg, nyng
451                   DO  k = nzb, nzt+1
452                      e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
453                   ENDDO
454                ENDDO
455             ENDDO
456
457          CASE ( 'lpt' )
458             DO  i = nxlg, nxrg
459                DO  j = nysg, nyng
460                   DO  k = nzb, nzt+1
461                      lpt_av(k,j,i) = lpt_av(k,j,i) + pt(k,j,i)
462                   ENDDO
463                ENDDO
464             ENDDO
465
466          CASE ( 'lwp*' )
467             DO  i = nxlg, nxrg
468                DO  j = nysg, nyng
469                   lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i)            &
470                                               * dzw(1:nzt+1) ) * rho_surface
471                ENDDO
472             ENDDO
473
474          CASE ( 'nr' )
475             DO  i = nxlg, nxrg
476                DO  j = nysg, nyng
477                   DO  k = nzb, nzt+1
478                      nr_av(k,j,i) = nr_av(k,j,i) + nr(k,j,i)
479                   ENDDO
480                ENDDO
481             ENDDO
482
483          CASE ( 'ol*' )
484             DO  i = nxlg, nxrg
485                DO  j = nysg, nyng
486                   ol_av(j,i) = ol_av(j,i) + ol(j,i)
487                ENDDO
488             ENDDO
489
490          CASE ( 'p' )
491             DO  i = nxlg, nxrg
492                DO  j = nysg, nyng
493                   DO  k = nzb, nzt+1
494                      p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
495                   ENDDO
496                ENDDO
497             ENDDO
498
499          CASE ( 'pc' )
500             DO  i = nxl, nxr
501                DO  j = nys, nyn
502                   DO  k = nzb, nzt+1
503                      pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
504                   ENDDO
505                ENDDO
506             ENDDO
507
508          CASE ( 'pr' )
509             DO  i = nxl, nxr
510                DO  j = nys, nyn
511                   DO  k = nzb, nzt+1
512                      number_of_particles = prt_count(k,j,i)
513                      IF ( number_of_particles <= 0 )  CYCLE
514                      particles => grid_particles(k,j,i)%particles(1:number_of_particles)
515                      s_r2 = 0.0_wp
516                      s_r3 = 0.0_wp
517
518                      DO  n = 1, number_of_particles
519                         IF ( particles(n)%particle_mask )  THEN
520                            s_r2 = s_r2 + particles(n)%radius**2 * &
521                                particles(n)%weight_factor
522                            s_r3 = s_r3 + particles(n)%radius**3 * &
523                                particles(n)%weight_factor
524                         ENDIF
525                      ENDDO
526
527                      IF ( s_r2 > 0.0_wp )  THEN
528                         mean_r = s_r3 / s_r2
529                      ELSE
530                         mean_r = 0.0_wp
531                      ENDIF
532                      pr_av(k,j,i) = pr_av(k,j,i) + mean_r
533                   ENDDO
534                ENDDO
535             ENDDO
536
537
538          CASE ( 'pr*' )
539             DO  i = nxlg, nxrg
540                DO  j = nysg, nyng
541                   precipitation_rate_av(j,i) = precipitation_rate_av(j,i) + &
542                                                precipitation_rate(j,i)
543                ENDDO
544             ENDDO
545
546          CASE ( 'pt' )
547             IF ( .NOT. cloud_physics ) THEN
548             DO  i = nxlg, nxrg
549                DO  j = nysg, nyng
550                   DO  k = nzb, nzt+1
551                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
552                      ENDDO
553                   ENDDO
554                ENDDO
555             ELSE
556             DO  i = nxlg, nxrg
557                DO  j = nysg, nyng
558                   DO  k = nzb, nzt+1
559                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + l_d_cp * &
560                                                       pt_d_t(k) * ql(k,j,i)
561                      ENDDO
562                   ENDDO
563                ENDDO
564             ENDIF
565
566          CASE ( 'q' )
567             DO  i = nxlg, nxrg
568                DO  j = nysg, nyng
569                   DO  k = nzb, nzt+1
570                      q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
571                   ENDDO
572                ENDDO
573             ENDDO
574
575          CASE ( 'qc' )
576             DO  i = nxlg, nxrg
577                DO  j = nysg, nyng
578                   DO  k = nzb, nzt+1
579                      qc_av(k,j,i) = qc_av(k,j,i) + qc(k,j,i)
580                   ENDDO
581                ENDDO
582             ENDDO
583
584          CASE ( 'ql' )
585             DO  i = nxlg, nxrg
586                DO  j = nysg, nyng
587                   DO  k = nzb, nzt+1
588                      ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
589                   ENDDO
590                ENDDO
591             ENDDO
592
593          CASE ( 'ql_c' )
594             DO  i = nxlg, nxrg
595                DO  j = nysg, nyng
596                   DO  k = nzb, nzt+1
597                      ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
598                   ENDDO
599                ENDDO
600             ENDDO
601
602          CASE ( 'ql_v' )
603             DO  i = nxlg, nxrg
604                DO  j = nysg, nyng
605                   DO  k = nzb, nzt+1
606                      ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
607                   ENDDO
608                ENDDO
609             ENDDO
610
611          CASE ( 'ql_vp' )
612             DO  i = nxl, nxr
613                DO  j = nys, nyn
614                   DO  k = nzb, nzt+1
615                      number_of_particles = prt_count(k,j,i)
616                      IF ( number_of_particles <= 0 )  CYCLE
617                      particles => grid_particles(k,j,i)%particles(1:number_of_particles)
618                      DO  n = 1, number_of_particles
619                         IF ( particles(n)%particle_mask )  THEN
620                            ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + &
621                                              particles(n)%weight_factor / &
622                                              number_of_particles
623                         ENDIF
624                      ENDDO
625                   ENDDO
626                ENDDO
627             ENDDO
628
629          CASE ( 'qr' )
630             DO  i = nxlg, nxrg
631                DO  j = nysg, nyng
632                   DO  k = nzb, nzt+1
633                      qr_av(k,j,i) = qr_av(k,j,i) + qr(k,j,i)
634                   ENDDO
635                ENDDO
636             ENDDO
637
638          CASE ( 'qsws*' )
639             DO  i = nxlg, nxrg
640                DO  j = nysg, nyng
641                   qsws_av(j,i) = qsws_av(j,i) + qsws(j,i)
642                ENDDO
643             ENDDO
644
645          CASE ( 'qv' )
646             DO  i = nxlg, nxrg
647                DO  j = nysg, nyng
648                   DO  k = nzb, nzt+1
649                      qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
650                   ENDDO
651                ENDDO
652             ENDDO
653
654          CASE ( 'rad_net*' )
655             DO  i = nxlg, nxrg
656                DO  j = nysg, nyng
657                   rad_net_av(j,i) = rad_net_av(j,i) + rad_net(j,i)
658                ENDDO
659             ENDDO
660
661          CASE ( 'rad_lw_in' )
662             DO  i = nxlg, nxrg
663                DO  j = nysg, nyng
664                   DO  k = nzb, nzt+1
665                      rad_lw_in_av(k,j,i) = rad_lw_in_av(k,j,i) + rad_lw_in(k,j,i)
666                   ENDDO
667                ENDDO
668             ENDDO
669
670          CASE ( 'rad_lw_out' )
671             DO  i = nxlg, nxrg
672                DO  j = nysg, nyng
673                   DO  k = nzb, nzt+1
674                      rad_lw_out_av(k,j,i) = rad_lw_out_av(k,j,i) + rad_lw_out(k,j,i)
675                   ENDDO
676                ENDDO
677             ENDDO
678
679          CASE ( 'rad_lw_cs_hr' )
680             DO  i = nxlg, nxrg
681                DO  j = nysg, nyng
682                   DO  k = nzb, nzt+1
683                      rad_lw_cs_hr_av(k,j,i) = rad_lw_cs_hr_av(k,j,i) + rad_lw_cs_hr(k,j,i)
684                   ENDDO
685                ENDDO
686             ENDDO
687
688          CASE ( 'rad_lw_hr' )
689             DO  i = nxlg, nxrg
690                DO  j = nysg, nyng
691                   DO  k = nzb, nzt+1
692                      rad_lw_hr_av(k,j,i) = rad_lw_hr_av(k,j,i) + rad_lw_hr(k,j,i)
693                   ENDDO
694                ENDDO
695             ENDDO
696
697          CASE ( 'rad_sw_in' )
698             DO  i = nxlg, nxrg
699                DO  j = nysg, nyng
700                   DO  k = nzb, nzt+1
701                      rad_sw_in_av(k,j,i) = rad_sw_in_av(k,j,i) + rad_sw_in(k,j,i)
702                   ENDDO
703                ENDDO
704             ENDDO
705
706          CASE ( 'rad_sw_out' )
707             DO  i = nxlg, nxrg
708                DO  j = nysg, nyng
709                   DO  k = nzb, nzt+1
710                      rad_sw_out_av(k,j,i) = rad_sw_out_av(k,j,i) + rad_sw_out(k,j,i)
711                   ENDDO
712                ENDDO
713             ENDDO
714
715          CASE ( 'rad_sw_cs_hr' )
716             DO  i = nxlg, nxrg
717                DO  j = nysg, nyng
718                   DO  k = nzb, nzt+1
719                      rad_sw_cs_hr_av(k,j,i) = rad_sw_cs_hr_av(k,j,i) + rad_sw_cs_hr(k,j,i)
720                   ENDDO
721                ENDDO
722             ENDDO
723
724          CASE ( 'rad_sw_hr' )
725             DO  i = nxlg, nxrg
726                DO  j = nysg, nyng
727                   DO  k = nzb, nzt+1
728                      rad_sw_hr_av(k,j,i) = rad_sw_hr_av(k,j,i) + rad_sw_hr(k,j,i)
729                   ENDDO
730                ENDDO
731             ENDDO
732
733          CASE ( 'rho' )
734             DO  i = nxlg, nxrg
735                DO  j = nysg, nyng
736                   DO  k = nzb, nzt+1
737                      rho_av(k,j,i) = rho_av(k,j,i) + rho(k,j,i)
738                   ENDDO
739                ENDDO
740             ENDDO
741
742          CASE ( 's' )
743             DO  i = nxlg, nxrg
744                DO  j = nysg, nyng
745                   DO  k = nzb, nzt+1
746                      s_av(k,j,i) = s_av(k,j,i) + q(k,j,i)
747                   ENDDO
748                ENDDO
749             ENDDO
750
751          CASE ( 'sa' )
752             DO  i = nxlg, nxrg
753                DO  j = nysg, nyng
754                   DO  k = nzb, nzt+1
755                      sa_av(k,j,i) = sa_av(k,j,i) + sa(k,j,i)
756                   ENDDO
757                ENDDO
758             ENDDO
759
760          CASE ( 'shf*' )
761             DO  i = nxlg, nxrg
762                DO  j = nysg, nyng
763                   shf_av(j,i) = shf_av(j,i) + shf(j,i)
764                ENDDO
765             ENDDO
766
767          CASE ( 'ssws*' )
768             DO  i = nxlg, nxrg
769                DO  j = nysg, nyng
770                   ssws_av(j,i) = ssws_av(j,i) + ssws(j,i)
771                ENDDO
772             ENDDO
773
774          CASE ( 't*' )
775             DO  i = nxlg, nxrg
776                DO  j = nysg, nyng
777                   ts_av(j,i) = ts_av(j,i) + ts(j,i)
778                ENDDO
779             ENDDO
780
781          CASE ( 'u' )
782             DO  i = nxlg, nxrg
783                DO  j = nysg, nyng
784                   DO  k = nzb, nzt+1
785                      u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
786                   ENDDO
787                ENDDO
788             ENDDO
789
790          CASE ( 'u*' )
791             DO  i = nxlg, nxrg
792                DO  j = nysg, nyng
793                   us_av(j,i) = us_av(j,i) + us(j,i)
794                ENDDO
795             ENDDO
796
797          CASE ( 'v' )
798             DO  i = nxlg, nxrg
799                DO  j = nysg, nyng
800                   DO  k = nzb, nzt+1
801                      v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
802                   ENDDO
803                ENDDO
804             ENDDO
805
806          CASE ( 'vpt' )
807             DO  i = nxlg, nxrg
808                DO  j = nysg, nyng
809                   DO  k = nzb, nzt+1
810                      vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
811                   ENDDO
812                ENDDO
813             ENDDO
814
815          CASE ( 'w' )
816             DO  i = nxlg, nxrg
817                DO  j = nysg, nyng
818                   DO  k = nzb, nzt+1
819                      w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
820                   ENDDO
821                ENDDO
822             ENDDO
823
824          CASE ( 'z0*' )
825             DO  i = nxlg, nxrg
826                DO  j = nysg, nyng
827                   z0_av(j,i) = z0_av(j,i) + z0(j,i)
828                ENDDO
829             ENDDO
830
831          CASE ( 'z0h*' )
832             DO  i = nxlg, nxrg
833                DO  j = nysg, nyng
834                   z0h_av(j,i) = z0h_av(j,i) + z0h(j,i)
835                ENDDO
836             ENDDO
837
838          CASE ( 'z0q*' )
839             DO  i = nxlg, nxrg
840                DO  j = nysg, nyng
841                   z0q_av(j,i) = z0q_av(j,i) + z0q(j,i)
842                ENDDO
843             ENDDO
844
845          CASE DEFAULT
846!
847!--          Land surface quantity
848             IF ( land_surface )  THEN
849                CALL lsm_3d_data_averaging( 'sum', doav(ii) )
850             ENDIF
851
852!
853!--          User-defined quantity
854             CALL user_3d_data_averaging( 'sum', doav(ii) )
855
856       END SELECT
857
858    ENDDO
859
860    CALL cpu_log( log_point(34), 'sum_up_3d_data', 'stop' )
861
862
863 END SUBROUTINE sum_up_3d_data
Note: See TracBrowser for help on using the repository browser.