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

Last change on this file since 2696 was 2696, checked in by kanani, 6 years ago

Merge of branch palm4u into trunk

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