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

Last change on this file since 3216 was 3176, checked in by suehring, 6 years ago

Major bugfix in calculation of ol and ts at building roofs; bugfix in restart data for surface elements; in 2D data output, mask latent heat flux at urban-type surfaces

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