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

Last change on this file since 2232 was 2232, checked in by suehring, 4 years ago

Adjustments according new topography and surface-modelling concept implemented

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