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

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

In case of natural- and urban-type surfaces output surfaces fluxes in W/m2

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