source: palm/trunk/SOURCE/flow_statistics.f90 @ 4178

Last change on this file since 4178 was 4131, checked in by monakurppa, 5 years ago

Several changes in the salsa aerosol module:

  • Add "salsa_" before each salsa output variable
  • Add a possibility to output the number (salsa_N_UFP) and mass concentration (salsa_PM0.1) of ultrafine particles, i.e. particles with a diameter smaller than 100 nm
  • Implement aerosol emission mode "parameterized" which is based on the street type (similar to the chemistry module).
  • Remove unnecessary nucleation subroutines.
  • Add the z-dimension for gaseous emissions to correspond the implementation in the chemistry module
  • Property svn:keywords set to Id
File size: 113.8 KB
RevLine 
[1682]1!> @file flow_statistics.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!
[3651]17! Copyright 1997-2019 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1036]19!
[254]20! Current revisions:
[3298]21! ------------------
[1961]22!
[3042]23!
[1739]24! Former revisions:
25! -----------------
26! $Id: flow_statistics.f90 4131 2019-08-02 11:06:18Z suehring $
[4131]27! Allow profile output for salsa variables.
28!
29! 4039 2019-06-18 10:32:41Z suehring
[4039]30! Correct conversion to kinematic scalar fluxes in case of pw-scheme and
31! statistic regions
32!
33! 3828 2019-03-27 19:36:23Z raasch
[3828]34! unused variables removed
35!
36! 3676 2019-01-16 15:07:05Z knoop
[3651]37! Bugfix, terminate OMP Parallel block
38!
39! 3637 2018-12-20 01:51:36Z knoop
[3637]40! Implementation of the PALM module interface
41!
42! 3458 2018-10-30 14:51:23Z kanani
[3458]43! from chemistry branch r3443, basit:
44! bug fixed in chemistry profiles
45!
46! 3452 2018-10-30 13:13:34Z schwenkel
[3452]47! Bugfix for profiles output
48!
49! 3298 2018-10-02 12:21:11Z kanani
[3298]50! - Minor formatting (kanani)
51! - Added  .AND. max_pr_cs > 0 before MPI_ALLREDUCE call (forkel)
52! - Data arrays, sums, sums_l, hom, hom_sum updated for chem species (basit)
53! - Directives of parallelism added for chemistry (basit)
54! - Call for chem_statistics added (basit)
55!
56! 3294 2018-10-01 02:37:10Z raasch
[3294]57! ocean renamed ocean_mode
58!
59! 3274 2018-09-24 15:42:55Z knoop
[3274]60! Modularization of all bulk cloud physics code components
61!
62! 3241 2018-09-12 15:02:00Z raasch
[3241]63! unused variables removed
64!
65! 3042 2018-05-25 10:44:37Z schwenkel
[3042]66! Changed the name specific humidity to mixing ratio
67!
68! 3040 2018-05-25 10:22:08Z schwenkel
[3004]69! Comments related to the calculation of the inversion height expanded
70!
71! 3003 2018-04-23 10:22:58Z Giersch
[3003]72! The inversion height will not be calcuated before the first timestep in
73! case of restarts.
74!
75! 2968 2018-04-13 11:52:24Z suehring
[2968]76! Bugfix in output of timeseries quantities in case of elevated model surfaces.
77!
78! 2817 2018-02-19 16:32:21Z knoop
[2817]79! Preliminary gust module interface implemented
80!
81! 2773 2018-01-30 14:12:54Z suehring
[2773]82! Timeseries output of surface temperature.
83!
84! 2753 2018-01-16 14:16:49Z suehring
[2753]85! Tile approach for spectral albedo implemented.
86!
87! 2718 2018-01-02 08:49:38Z maronga
[2716]88! Corrected "Former revisions" section
89!
90! 2696 2017-12-14 17:12:51Z kanani
91! Change in file header (GPL part)
[2696]92! Bugfix in evaluation of surface quantities in case different surface types
93! are used (MS)
94!
95! 2674 2017-12-07 11:49:21Z suehring
[2674]96! Bugfix in output conversion of resolved-scale momentum fluxes in case of
97! PW advections scheme.
98!
99! 2320 2017-07-21 12:47:43Z suehring
[2320]100! Modularize large-scale forcing and nudging
101!
102! 2296 2017-06-28 07:53:56Z maronga
[2296]103! Enabled output of radiation quantities for radiation_scheme = 'constant'
104!
105! 2292 2017-06-20 09:51:42Z schwenkel
[2292]106! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
107! includes two more prognostic equations for cloud drop concentration (nc) 
108! and cloud water content (qc).
109!
110! 2270 2017-06-09 12:18:47Z maronga
[2270]111! Revised numbering (removed 2 timeseries)
112!
113! 2252 2017-06-07 09:35:37Z knoop
[2252]114! perturbation pressure now depending on flux_output_mode
115!
116! 2233 2017-05-30 18:08:54Z suehring
[1739]117!
[2233]118! 2232 2017-05-30 17:47:52Z suehring
119! Adjustments to new topography and surface concept
120!
[2119]121! 2118 2017-01-17 16:38:49Z raasch
122! OpenACC version of subroutine removed
123!
[2074]124! 2073 2016-11-30 14:34:05Z raasch
125! openmp bugfix: large scale forcing calculations cannot be executed thread
126! parallel
127!
[2038]128! 2037 2016-10-26 11:15:40Z knoop
129! Anelastic approximation implemented
130!
[2032]131! 2031 2016-10-21 15:11:58Z knoop
132! renamed variable rho to rho_ocean
133!
[2027]134! 2026 2016-10-18 10:27:02Z suehring
135! Bugfix, enable output of s*2.
136! Change, calculation of domain-averaged perturbation energy.
137! Some formatting adjustments.
138!
[2001]139! 2000 2016-08-20 18:09:15Z knoop
140! Forced header and separation lines into 80 columns
141!
[1977]142! 1976 2016-07-27 13:28:04Z maronga
143! Removed some unneeded __rrtmg preprocessor directives
144!
[1961]145! 1960 2016-07-12 16:34:24Z suehring
146! Separate humidity and passive scalar
147!
[1919]148! 1918 2016-05-27 14:35:57Z raasch
149! in case of Wicker-Skamarock scheme, calculate disturbance kinetic energy here,
150! if flow_statistics is called before the first initial time step
151!
[1854]152! 1853 2016-04-11 09:00:35Z maronga
153! Adjusted for use with radiation_scheme = constant
154!
[1851]155! 1849 2016-04-08 11:33:18Z hoffmann
156! prr moved to arrays_3d
157!
[1823]158! 1822 2016-04-07 07:49:42Z hoffmann
159! Output of bulk microphysics simplified.
160!
[1816]161! 1815 2016-04-06 13:49:59Z raasch
162! cpp-directives for intel openmp bug removed
163!
[1784]164! 1783 2016-03-06 18:36:17Z raasch
165! +module netcdf_interface
166!
[1748]167! 1747 2016-02-08 12:25:53Z raasch
168! small bugfixes for accelerator version
169!
[1739]170! 1738 2015-12-18 13:56:05Z raasch
[1738]171! bugfixes for calculations in statistical regions which do not contain grid
172! points in the lowest vertical levels, mean surface level height considered
173! in the calculation of the characteristic vertical velocity,
174! old upstream parts removed
[1383]175!
[1710]176! 1709 2015-11-04 14:47:01Z maronga
177! Updated output of Obukhov length
178!
[1692]179! 1691 2015-10-26 16:17:44Z maronga
180! Revised calculation of Obukhov length. Added output of radiative heating >
181! rates for RRTMG.
182!
[1683]183! 1682 2015-10-07 23:56:08Z knoop
184! Code annotations made doxygen readable
185!
[1659]186! 1658 2015-09-18 10:52:53Z raasch
187! bugfix: temporary reduction variables in the openacc branch are now
188! initialized to zero
189!
[1655]190! 1654 2015-09-17 09:20:17Z raasch
191! FORTRAN bugfix of r1652
192!
[1653]193! 1652 2015-09-17 08:12:24Z raasch
194! bugfix in calculation of energy production by turbulent transport of TKE
195!
[1594]196! 1593 2015-05-16 13:58:02Z raasch
197! FORTRAN errors removed from openacc branch
198!
[1586]199! 1585 2015-04-30 07:05:52Z maronga
200! Added output of timeseries and profiles for RRTMG
201!
[1572]202! 1571 2015-03-12 16:12:49Z maronga
203! Bugfix: output of rad_net and rad_sw_in
204!
[1568]205! 1567 2015-03-10 17:57:55Z suehring
206! Reverse modifications made for monotonic limiter.
207!
[1558]208! 1557 2015-03-05 16:43:04Z suehring
209! Adjustments for monotonic limiter
210!
[1556]211! 1555 2015-03-04 17:44:27Z maronga
212! Added output of r_a and r_s.
213!
[1552]214! 1551 2015-03-03 14:18:16Z maronga
215! Added suppport for land surface model and radiation model output.
216!
[1499]217! 1498 2014-12-03 14:09:51Z suehring
218! Comments added
219!
[1483]220! 1482 2014-10-18 12:34:45Z raasch
221! missing ngp_sums_ls added in accelerator version
222!
[1451]223! 1450 2014-08-21 07:31:51Z heinze
224! bugfix: calculate fac only for simulated_time >= 0.0
225!
[1397]226! 1396 2014-05-06 13:37:41Z raasch
227! bugfix: "copyin" replaced by "update device" in openacc-branch
228!
[1387]229! 1386 2014-05-05 13:55:30Z boeske
230! bugfix: simulated time before the last timestep is needed for the correct
231! calculation of the profiles of large scale forcing tendencies
232!
[1383]233! 1382 2014-04-30 12:15:41Z boeske
[1382]234! Renamed variables which store large scale forcing tendencies
235! pt_lsa -> td_lsa_lpt, pt_subs -> td_sub_lpt,
236! q_lsa  -> td_lsa_q,   q_subs  -> td_sub_q,
237! added Neumann boundary conditions for profile data output of large scale
238! advection and subsidence terms at nzt+1
[1354]239!
[1375]240! 1374 2014-04-25 12:55:07Z raasch
241! bugfix: syntax errors removed from openacc-branch
242! missing variables added to ONLY-lists
243!
[1366]244! 1365 2014-04-22 15:03:56Z boeske
245! Output of large scale advection, large scale subsidence and nudging tendencies
246! +sums_ls_l, ngp_sums_ls, use_subsidence_tendencies
247!
[1354]248! 1353 2014-04-08 15:21:23Z heinze
249! REAL constants provided with KIND-attribute
250!
[1323]251! 1322 2014-03-20 16:38:49Z raasch
252! REAL constants defined as wp-kind
253!
[1321]254! 1320 2014-03-20 08:40:49Z raasch
[1320]255! ONLY-attribute added to USE-statements,
256! kind-parameters added to all INTEGER and REAL declaration statements,
257! kinds are defined in new module kinds,
258! revision history before 2012 removed,
259! comment fields (!:) to be used for variable explanations added to
260! all variable declaration statements
[1008]261!
[1300]262! 1299 2014-03-06 13:15:21Z heinze
263! Output of large scale vertical velocity w_subs
264!
[1258]265! 1257 2013-11-08 15:18:40Z raasch
266! openacc "end parallel" replaced by "end parallel loop"
267!
[1242]268! 1241 2013-10-30 11:36:58Z heinze
269! Output of ug and vg
270!
[1222]271! 1221 2013-09-10 08:59:13Z raasch
272! ported for openACC in separate #else branch
273!
[1182]274! 1179 2013-06-14 05:57:58Z raasch
275! comment for profile 77 added
276!
[1116]277! 1115 2013-03-26 18:16:16Z hoffmann
278! ql is calculated by calc_liquid_water_content
279!
[1112]280! 1111 2013-03-08 23:54:10Z raasch
281! openACC directive added
282!
[1054]283! 1053 2012-11-13 17:11:03Z hoffmann
[1112]284! additions for two-moment cloud physics scheme:
[1054]285! +nr, qr, qc, prr
286!
[1037]287! 1036 2012-10-22 13:43:42Z raasch
288! code put under GPL (PALM 3.9)
289!
[1008]290! 1007 2012-09-19 14:30:36Z franke
[1007]291! Calculation of buoyancy flux for humidity in case of WS-scheme is now using
292! turbulent fluxes of WS-scheme
293! Bugfix: Calculation of subgridscale buoyancy flux for humidity and cloud
294! droplets at nzb and nzt added
[700]295!
[802]296! 801 2012-01-10 17:30:36Z suehring
297! Calculation of turbulent fluxes in advec_ws is now thread-safe.
298!
[1]299! Revision 1.1  1997/08/11 06:15:17  raasch
300! Initial revision
301!
302!
303! Description:
304! ------------
[1682]305!> Compute average profiles and further average flow quantities for the different
306!> user-defined (sub-)regions. The region indexed 0 is the total model domain.
307!>
308!> @note For simplicity, nzb_s_inner and nzb_diff_s_inner are being used as a
309!>       lower vertical index for k-loops for all variables, although strictly
310!>       speaking the k-loops would have to be split up according to the staggered
311!>       grid. However, this implies no error since staggered velocity components
312!>       are zero at the walls and inside buildings.
[1]313!------------------------------------------------------------------------------!
[1682]314 SUBROUTINE flow_statistics
[1]315
[3298]316
[1320]317    USE arrays_3d,                                                             &
[2037]318        ONLY:  ddzu, ddzw, e, heatflux_output_conversion, hyp, km, kh,         &
[2292]319               momentumflux_output_conversion, nc, nr, p, prho, prr, pt, q,    &
[2232]320               qc, ql, qr, rho_air, rho_air_zw, rho_ocean, s,                  &
[3274]321               sa, u, ug, v, vg, vpt, w, w_subs, waterflux_output_conversion,  &
322               zw, d_exner
[3298]323
[3274]324    USE basic_constants_and_equations_mod,                                     &
[3298]325        ONLY:  g, lv_d_cp
326
[3637]327    USE bulk_cloud_model_mod,                                                  &
328        ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert
[3298]329
330    USE chem_modules,                                                          &
331        ONLY:  max_pr_cs
332
[1320]333    USE control_parameters,                                                    &
[3298]334        ONLY:   air_chemistry, average_count_pr, cloud_droplets, do_sum,       &
[3274]335                dt_3d, humidity, initializing_actions, land_surface,           &
[3003]336                large_scale_forcing, large_scale_subsidence, max_pr_user,      &
[3294]337                message_string, neutral, ocean_mode, passive_scalar,           &
338                simulated_time, simulated_time_at_begin,                       &
339                use_subsidence_tendencies, use_surface_fluxes, use_top_fluxes, &
[4131]340                ws_scheme_mom, ws_scheme_sca, salsa, max_pr_salsa
[3298]341
[1320]342    USE cpulog,                                                                &
[1551]343        ONLY:   cpu_log, log_point
[3298]344
[1320]345    USE grid_variables,                                                        &
[1551]346        ONLY:   ddx, ddy
[1320]347       
348    USE indices,                                                               &
[1551]349        ONLY:   ngp_2dh, ngp_2dh_s_inner, ngp_3d, ngp_3d_inner, ngp_sums,      &
[2968]350                ngp_sums_ls, nxl, nxr, nyn, nys, nzb, nzt, topo_min_level,     &
351                wall_flags_0
[1320]352       
353    USE kinds
354   
[1551]355    USE land_surface_model_mod,                                                &
[2232]356        ONLY:   m_soil_h, nzb_soil, nzt_soil, t_soil_h
[1551]357
[2320]358    USE lsf_nudging_mod,                                                       &
359        ONLY:   td_lsa_lpt, td_lsa_q, td_sub_lpt, td_sub_q, time_vert
360
[3637]361    USE module_interface,                                                      &
362        ONLY:  module_interface_statistics
363
[1783]364    USE netcdf_interface,                                                      &
[2817]365        ONLY:  dots_rad, dots_soil, dots_max
[1783]366
[1]367    USE pegrid
[1551]368
369    USE radiation_model_mod,                                                   &
[2696]370        ONLY:  radiation, radiation_scheme,                                    &
[1691]371               rad_lw_in, rad_lw_out, rad_lw_cs_hr, rad_lw_hr,                 &
372               rad_sw_in, rad_sw_out, rad_sw_cs_hr, rad_sw_hr
[1585]373
[1]374    USE statistics
375
[3828]376    USE surface_mod,                                                           &
377        ONLY :  surf_def_h, surf_lsm_h, surf_usm_h
[1691]378
[2232]379
[1]380    IMPLICIT NONE
381
[1682]382    INTEGER(iwp) ::  i                   !<
383    INTEGER(iwp) ::  j                   !<
384    INTEGER(iwp) ::  k                   !<
[2232]385    INTEGER(iwp) ::  ki                  !<
[1738]386    INTEGER(iwp) ::  k_surface_level     !<
[2232]387    INTEGER(iwp) ::  m                   !< loop variable over all horizontal wall elements
388    INTEGER(iwp) ::  l                   !< loop variable over surface facing -- up- or downward-facing
[1682]389    INTEGER(iwp) ::  nt                  !<
[3241]390!$  INTEGER(iwp) ::  omp_get_thread_num  !<
[1682]391    INTEGER(iwp) ::  sr                  !<
392    INTEGER(iwp) ::  tn                  !<
[2232]393
[1682]394    LOGICAL ::  first  !<
[1320]395   
[1682]396    REAL(wp) ::  dptdz_threshold  !<
397    REAL(wp) ::  fac              !<
[2232]398    REAL(wp) ::  flag             !<
[1682]399    REAL(wp) ::  height           !<
400    REAL(wp) ::  pts              !<
401    REAL(wp) ::  sums_l_etot      !<
402    REAL(wp) ::  ust              !<
403    REAL(wp) ::  ust2             !<
404    REAL(wp) ::  u2               !<
405    REAL(wp) ::  vst              !<
406    REAL(wp) ::  vst2             !<
407    REAL(wp) ::  v2               !<
408    REAL(wp) ::  w2               !<
[1320]409   
[1682]410    REAL(wp) ::  dptdz(nzb+1:nzt+1)    !<
411    REAL(wp) ::  sums_ll(nzb:nzt+1,2)  !<
[1]412
413    CALL cpu_log( log_point(10), 'flow_statistics', 'start' )
414
[1221]415
[1]416!
417!-- To be on the safe side, check whether flow_statistics has already been
418!-- called once after the current time step
419    IF ( flow_statistics_called )  THEN
[254]420
[274]421       message_string = 'flow_statistics is called two times within one ' // &
422                        'timestep'
[254]423       CALL message( 'flow_statistics', 'PA0190', 1, 2, 0, 6, 0 )
[1007]424
[1]425    ENDIF
426
427!
428!-- Compute statistics for each (sub-)region
429    DO  sr = 0, statistic_regions
430
431!
432!--    Initialize (local) summation array
[1353]433       sums_l = 0.0_wp
[3658]434#ifdef _OPENACC
435       !$ACC KERNELS PRESENT(sums_l)
436       sums_l = 0.0_wp
437       !$ACC END KERNELS
438#endif
[1]439
440!
441!--    Store sums that have been computed in other subroutines in summation
442!--    array
443       sums_l(:,11,:) = sums_l_l(:,sr,:)      ! mixing length from diffusivities
444!--    WARNING: next line still has to be adjusted for OpenMP
[2037]445       sums_l(:,21,0) = sums_wsts_bc_l(:,sr) *                                 &
446                        heatflux_output_conversion  ! heat flux from advec_s_bc
[87]447       sums_l(nzb+9,pr_palm,0)  = sums_divold_l(sr)  ! old divergence from pres
448       sums_l(nzb+10,pr_palm,0) = sums_divnew_l(sr)  ! new divergence from pres
[1]449
[667]450!
[1498]451!--    When calcuating horizontally-averaged total (resolved- plus subgrid-
452!--    scale) vertical fluxes and velocity variances by using commonly-
453!--    applied Reynolds-based methods ( e.g. <w'pt'> = (w-<w>)*(pt-<pt>) )
454!--    in combination with the 5th order advection scheme, pronounced
455!--    artificial kinks could be observed in the vertical profiles near the
456!--    surface. Please note: these kinks were not related to the model truth,
457!--    i.e. these kinks are just related to an evaluation problem.   
458!--    In order avoid these kinks, vertical fluxes and horizontal as well
459!--    vertical velocity variances are calculated directly within the advection
460!--    routines, according to the numerical discretization, to evaluate the
461!--    statistical quantities as they will appear within the prognostic
462!--    equations.
[667]463!--    Copy the turbulent quantities, evaluated in the advection routines to
[1498]464!--    the local array sums_l() for further computations.
[743]465       IF ( ws_scheme_mom .AND. sr == 0 )  THEN
[696]466
[1007]467!
[673]468!--       According to the Neumann bc for the horizontal velocity components,
469!--       the corresponding fluxes has to satisfiy the same bc.
[3294]470          IF ( ocean_mode )  THEN
[801]471             sums_us2_ws_l(nzt+1,:) = sums_us2_ws_l(nzt,:)
[1007]472             sums_vs2_ws_l(nzt+1,:) = sums_vs2_ws_l(nzt,:)
[673]473          ENDIF
[696]474
475          DO  i = 0, threads_per_task-1
[1007]476!
[696]477!--          Swap the turbulent quantities evaluated in advec_ws.
[2037]478             sums_l(:,13,i) = sums_wsus_ws_l(:,i)                              &
479                              * momentumflux_output_conversion ! w*u*
480             sums_l(:,15,i) = sums_wsvs_ws_l(:,i)                              &
481                              * momentumflux_output_conversion ! w*v*
[801]482             sums_l(:,30,i) = sums_us2_ws_l(:,i)        ! u*2
483             sums_l(:,31,i) = sums_vs2_ws_l(:,i)        ! v*2
484             sums_l(:,32,i) = sums_ws2_ws_l(:,i)        ! w*2
[1353]485             sums_l(:,34,i) = sums_l(:,34,i) + 0.5_wp *                        & 
[1320]486                              ( sums_us2_ws_l(:,i) + sums_vs2_ws_l(:,i) +      &
[801]487                                sums_ws2_ws_l(:,i) )    ! e*
[667]488          ENDDO
[696]489
[667]490       ENDIF
[696]491
[1567]492       IF ( ws_scheme_sca .AND. sr == 0 )  THEN
[696]493
494          DO  i = 0, threads_per_task-1
[2037]495             sums_l(:,17,i)                        = sums_wspts_ws_l(:,i)      &
496                                           * heatflux_output_conversion  ! w*pt*
[3294]497             IF ( ocean_mode     ) sums_l(:,66,i)  = sums_wssas_ws_l(:,i) ! w*sa*
[2037]498             IF ( humidity       ) sums_l(:,49,i)  = sums_wsqs_ws_l(:,i)       &
499                                           * waterflux_output_conversion  ! w*q*
[2270]500             IF ( passive_scalar ) sums_l(:,114,i) = sums_wsss_ws_l(:,i)  ! w*s*
[696]501          ENDDO
502
[667]503       ENDIF
[305]504!
[1]505!--    Horizontally averaged profiles of horizontal velocities and temperature.
506!--    They must have been computed before, because they are already required
507!--    for other horizontal averages.
508       tn = 0
[2232]509       !$OMP PARALLEL PRIVATE( i, j, k, tn, flag )
510       !$ tn = omp_get_thread_num()
[1]511       !$OMP DO
[3658]512       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
513       !$ACC PRESENT(wall_flags_0, u, v, pt, rmask, sums_l)
[1]514       DO  i = nxl, nxr
515          DO  j =  nys, nyn
[2232]516             DO  k = nzb, nzt+1
517                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
[3658]518                !$ACC ATOMIC
[2232]519                sums_l(k,1,tn)  = sums_l(k,1,tn)  + u(k,j,i)  * rmask(j,i,sr)  &
520                                                              * flag
[3658]521                !$ACC ATOMIC
[2232]522                sums_l(k,2,tn)  = sums_l(k,2,tn)  + v(k,j,i)  * rmask(j,i,sr)  &
523                                                              * flag
[3658]524                !$ACC ATOMIC
[2232]525                sums_l(k,4,tn)  = sums_l(k,4,tn)  + pt(k,j,i) * rmask(j,i,sr)  &
526                                                              * flag
[1]527             ENDDO
528          ENDDO
529       ENDDO
[3658]530       !$ACC UPDATE HOST(sums_l(:,1,tn), sums_l(:,2,tn), sums_l(:,4,tn))
[1]531
532!
[96]533!--    Horizontally averaged profile of salinity
[3294]534       IF ( ocean_mode )  THEN
[96]535          !$OMP DO
536          DO  i = nxl, nxr
537             DO  j =  nys, nyn
[2232]538                DO  k = nzb, nzt+1
539                   sums_l(k,23,tn)  = sums_l(k,23,tn) + sa(k,j,i)              &
540                                    * rmask(j,i,sr)                            &
541                                    * MERGE( 1.0_wp, 0.0_wp,                   &
542                                             BTEST( wall_flags_0(k,j,i), 22 ) )
[96]543                ENDDO
544             ENDDO
545          ENDDO
546       ENDIF
547
548!
[1]549!--    Horizontally averaged profiles of virtual potential temperature,
[3040]550!--    total water content, water vapor mixing ratio and liquid water potential
[1]551!--    temperature
[75]552       IF ( humidity )  THEN
[1]553          !$OMP DO
554          DO  i = nxl, nxr
555             DO  j =  nys, nyn
[2232]556                DO  k = nzb, nzt+1
557                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
558                   sums_l(k,44,tn)  = sums_l(k,44,tn) +                        &
559                                      vpt(k,j,i) * rmask(j,i,sr) * flag
560                   sums_l(k,41,tn)  = sums_l(k,41,tn) +                        &
561                                      q(k,j,i) * rmask(j,i,sr)   * flag
[1]562                ENDDO
563             ENDDO
564          ENDDO
[3274]565          IF ( bulk_cloud_model )  THEN
[1]566             !$OMP DO
567             DO  i = nxl, nxr
568                DO  j =  nys, nyn
[2232]569                   DO  k = nzb, nzt+1
570                      flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
571                      sums_l(k,42,tn) = sums_l(k,42,tn) +                      &
572                                      ( q(k,j,i) - ql(k,j,i) ) * rmask(j,i,sr) &
573                                                               * flag
574                      sums_l(k,43,tn) = sums_l(k,43,tn) + (                    &
[3274]575                                      pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i) &
[2232]576                                                          ) * rmask(j,i,sr)    &
577                                                            * flag
[1]578                   ENDDO
579                ENDDO
580             ENDDO
581          ENDIF
582       ENDIF
583
584!
585!--    Horizontally averaged profiles of passive scalar
586       IF ( passive_scalar )  THEN
587          !$OMP DO
588          DO  i = nxl, nxr
589             DO  j =  nys, nyn
[2232]590                DO  k = nzb, nzt+1
[2270]591                   sums_l(k,115,tn)  = sums_l(k,115,tn) + s(k,j,i)             &
[2232]592                                    * rmask(j,i,sr)                            &
593                                    * MERGE( 1.0_wp, 0.0_wp,                   &
594                                             BTEST( wall_flags_0(k,j,i), 22 ) )
[1]595                ENDDO
596             ENDDO
597          ENDDO
598       ENDIF
599       !$OMP END PARALLEL
600!
601!--    Summation of thread sums
602       IF ( threads_per_task > 1 )  THEN
603          DO  i = 1, threads_per_task-1
604             sums_l(:,1,0) = sums_l(:,1,0) + sums_l(:,1,i)
605             sums_l(:,2,0) = sums_l(:,2,0) + sums_l(:,2,i)
606             sums_l(:,4,0) = sums_l(:,4,0) + sums_l(:,4,i)
[3294]607             IF ( ocean_mode )  THEN
[96]608                sums_l(:,23,0) = sums_l(:,23,0) + sums_l(:,23,i)
609             ENDIF
[75]610             IF ( humidity )  THEN
[1]611                sums_l(:,41,0) = sums_l(:,41,0) + sums_l(:,41,i)
612                sums_l(:,44,0) = sums_l(:,44,0) + sums_l(:,44,i)
[3274]613                IF ( bulk_cloud_model )  THEN
[1]614                   sums_l(:,42,0) = sums_l(:,42,0) + sums_l(:,42,i)
615                   sums_l(:,43,0) = sums_l(:,43,0) + sums_l(:,43,i)
616                ENDIF
617             ENDIF
618             IF ( passive_scalar )  THEN
[2270]619                sums_l(:,115,0) = sums_l(:,115,0) + sums_l(:,115,i)
[1]620             ENDIF
621          ENDDO
622       ENDIF
623
624#if defined( __parallel )
625!
626!--    Compute total sum from local sums
[622]627       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[1320]628       CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), nzt+2-nzb, MPI_REAL,  &
[1]629                           MPI_SUM, comm2d, ierr )
[622]630       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[1320]631       CALL MPI_ALLREDUCE( sums_l(nzb,2,0), sums(nzb,2), nzt+2-nzb, MPI_REAL,  &
[1]632                           MPI_SUM, comm2d, ierr )
[622]633       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[1320]634       CALL MPI_ALLREDUCE( sums_l(nzb,4,0), sums(nzb,4), nzt+2-nzb, MPI_REAL,  &
[1]635                           MPI_SUM, comm2d, ierr )
[3294]636       IF ( ocean_mode )  THEN
[622]637          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[1320]638          CALL MPI_ALLREDUCE( sums_l(nzb,23,0), sums(nzb,23), nzt+2-nzb,       &
[96]639                              MPI_REAL, MPI_SUM, comm2d, ierr )
640       ENDIF
[75]641       IF ( humidity ) THEN
[622]642          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[1320]643          CALL MPI_ALLREDUCE( sums_l(nzb,44,0), sums(nzb,44), nzt+2-nzb,       &
[1]644                              MPI_REAL, MPI_SUM, comm2d, ierr )
[622]645          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[1320]646          CALL MPI_ALLREDUCE( sums_l(nzb,41,0), sums(nzb,41), nzt+2-nzb,       &
[1]647                              MPI_REAL, MPI_SUM, comm2d, ierr )
[3274]648          IF ( bulk_cloud_model ) THEN
[622]649             IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[1320]650             CALL MPI_ALLREDUCE( sums_l(nzb,42,0), sums(nzb,42), nzt+2-nzb,    &
[1]651                                 MPI_REAL, MPI_SUM, comm2d, ierr )
[622]652             IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[1320]653             CALL MPI_ALLREDUCE( sums_l(nzb,43,0), sums(nzb,43), nzt+2-nzb,    &
[1]654                                 MPI_REAL, MPI_SUM, comm2d, ierr )
655          ENDIF
656       ENDIF
657
658       IF ( passive_scalar )  THEN
[622]659          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[2270]660          CALL MPI_ALLREDUCE( sums_l(nzb,115,0), sums(nzb,115), nzt+2-nzb,       &
[1]661                              MPI_REAL, MPI_SUM, comm2d, ierr )
662       ENDIF
663#else
664       sums(:,1) = sums_l(:,1,0)
665       sums(:,2) = sums_l(:,2,0)
666       sums(:,4) = sums_l(:,4,0)
[3294]667       IF ( ocean_mode )  sums(:,23) = sums_l(:,23,0)
[75]668       IF ( humidity ) THEN
[1]669          sums(:,44) = sums_l(:,44,0)
670          sums(:,41) = sums_l(:,41,0)
[3274]671          IF ( bulk_cloud_model ) THEN
[1]672             sums(:,42) = sums_l(:,42,0)
673             sums(:,43) = sums_l(:,43,0)
674          ENDIF
675       ENDIF
[2270]676       IF ( passive_scalar )  sums(:,115) = sums_l(:,115,0)
[1]677#endif
678
679!
680!--    Final values are obtained by division by the total number of grid points
681!--    used for summation. After that store profiles.
[132]682       sums(:,1) = sums(:,1) / ngp_2dh(sr)
683       sums(:,2) = sums(:,2) / ngp_2dh(sr)
684       sums(:,4) = sums(:,4) / ngp_2dh_s_inner(:,sr)
[1]685       hom(:,1,1,sr) = sums(:,1)             ! u
686       hom(:,1,2,sr) = sums(:,2)             ! v
687       hom(:,1,4,sr) = sums(:,4)             ! pt
[3658]688       !$ACC UPDATE DEVICE(hom(:,1,1,sr), hom(:,1,2,sr), hom(:,1,4,sr))
[1]689
[667]690
[1]691!
[96]692!--    Salinity
[3294]693       IF ( ocean_mode )  THEN
[132]694          sums(:,23) = sums(:,23) / ngp_2dh_s_inner(:,sr)
[96]695          hom(:,1,23,sr) = sums(:,23)             ! sa
696       ENDIF
697
698!
[1]699!--    Humidity and cloud parameters
[75]700       IF ( humidity ) THEN
[132]701          sums(:,44) = sums(:,44) / ngp_2dh_s_inner(:,sr)
702          sums(:,41) = sums(:,41) / ngp_2dh_s_inner(:,sr)
[1]703          hom(:,1,44,sr) = sums(:,44)             ! vpt
704          hom(:,1,41,sr) = sums(:,41)             ! qv (q)
[3274]705          IF ( bulk_cloud_model ) THEN
[132]706             sums(:,42) = sums(:,42) / ngp_2dh_s_inner(:,sr)
707             sums(:,43) = sums(:,43) / ngp_2dh_s_inner(:,sr)
[1]708             hom(:,1,42,sr) = sums(:,42)             ! qv
709             hom(:,1,43,sr) = sums(:,43)             ! pt
710          ENDIF
711       ENDIF
712
713!
714!--    Passive scalar
[2270]715       IF ( passive_scalar )  hom(:,1,115,sr) = sums(:,115) /                  &
[1960]716            ngp_2dh_s_inner(:,sr)                    ! s
[1]717
718!
719!--    Horizontally averaged profiles of the remaining prognostic variables,
720!--    variances, the total and the perturbation energy (single values in last
721!--    column of sums_l) and some diagnostic quantities.
[132]722!--    NOTE: for simplicity, nzb_s_inner is used below, although strictly
[1]723!--    ----  speaking the following k-loop would have to be split up and
724!--          rearranged according to the staggered grid.
[132]725!--          However, this implies no error since staggered velocity components
726!--          are zero at the walls and inside buildings.
[1]727       tn = 0
[3241]728       !$OMP PARALLEL PRIVATE( i, j, k, pts, sums_ll,                          &
[1815]729       !$OMP                   sums_l_etot, tn, ust, ust2, u2, vst, vst2, v2,  &
[2232]730       !$OMP                   w2, flag, m, ki, l )
731       !$ tn = omp_get_thread_num()
[1]732       !$OMP DO
[3658]733       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, m) &
734       !$ACC PRIVATE(sums_l_etot, flag) &
735       !$ACC PRESENT(wall_flags_0, rmask, momentumflux_output_conversion) &
736       !$ACC PRESENT(hom(:,1,4,sr)) &
737       !$ACC PRESENT(e, u, v, w, km, kh, p, pt) &
738       !$ACC PRESENT(surf_def_h(0), surf_lsm_h, surf_usm_h) &
739       !$ACC PRESENT(sums_l)
[1]740       DO  i = nxl, nxr
741          DO  j =  nys, nyn
[1353]742             sums_l_etot = 0.0_wp
[2232]743             DO  k = nzb, nzt+1
744                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
[1]745!
746!--             Prognostic and diagnostic variables
[3658]747                !$ACC ATOMIC
[2232]748                sums_l(k,3,tn)  = sums_l(k,3,tn)  + w(k,j,i)  * rmask(j,i,sr)  &
749                                                              * flag
[3658]750                !$ACC ATOMIC
[2232]751                sums_l(k,8,tn)  = sums_l(k,8,tn)  + e(k,j,i)  * rmask(j,i,sr)  &
752                                                              * flag
[3658]753                !$ACC ATOMIC
[2232]754                sums_l(k,9,tn)  = sums_l(k,9,tn)  + km(k,j,i) * rmask(j,i,sr)  &
755                                                              * flag
[3658]756                !$ACC ATOMIC
[2232]757                sums_l(k,10,tn) = sums_l(k,10,tn) + kh(k,j,i) * rmask(j,i,sr)  &
758                                                              * flag
[3658]759                !$ACC ATOMIC
[2252]760                sums_l(k,40,tn) = sums_l(k,40,tn) + ( p(k,j,i)                 &
761                                         / momentumflux_output_conversion(k) ) &
762                                                              * flag
[1]763
[3658]764                !$ACC ATOMIC
[1]765                sums_l(k,33,tn) = sums_l(k,33,tn) + &
[2232]766                                  ( pt(k,j,i)-hom(k,1,4,sr) )**2 * rmask(j,i,sr)&
767                                                                 * flag
[3658]768#ifndef _OPENACC
[624]769                IF ( humidity )  THEN
770                   sums_l(k,70,tn) = sums_l(k,70,tn) + &
[2232]771                                  ( q(k,j,i)-hom(k,1,41,sr) )**2 * rmask(j,i,sr)&
772                                                                 * flag
[624]773                ENDIF
[1960]774                IF ( passive_scalar )  THEN
[2270]775                   sums_l(k,116,tn) = sums_l(k,116,tn) + &
776                                  ( s(k,j,i)-hom(k,1,115,sr) )**2 * rmask(j,i,sr)&
[2232]777                                                                  * flag
[1960]778                ENDIF
[3658]779#endif
[699]780!
781!--             Higher moments
782!--             (Computation of the skewness of w further below)
[3658]783                !$ACC ATOMIC
[2232]784                sums_l(k,38,tn) = sums_l(k,38,tn) + w(k,j,i)**3 * rmask(j,i,sr) &
785                                                                * flag
[667]786
[1]787                sums_l_etot  = sums_l_etot + &
[2232]788                                        0.5_wp * ( u(k,j,i)**2 + v(k,j,i)**2 +  &
789                                        w(k,j,i)**2 )            * rmask(j,i,sr)&
790                                                                 * flag
[1]791             ENDDO
792!
793!--          Total and perturbation energy for the total domain (being
794!--          collected in the last column of sums_l). Summation of these
795!--          quantities is seperated from the previous loop in order to
796!--          allow vectorization of that loop.
[3658]797             !$ACC ATOMIC
[87]798             sums_l(nzb+4,pr_palm,tn) = sums_l(nzb+4,pr_palm,tn) + sums_l_etot
[1]799!
800!--          2D-arrays (being collected in the last column of sums_l)
[2773]801             IF ( surf_def_h(0)%end_index(j,i) >=                              &
[2696]802                  surf_def_h(0)%start_index(j,i) )  THEN
[2232]803                m = surf_def_h(0)%start_index(j,i)
[3658]804                !$ACC ATOMIC
[2773]805                sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +            &
[2232]806                                        surf_def_h(0)%us(m)   * rmask(j,i,sr)
[3658]807                !$ACC ATOMIC
[2773]808                sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) +          &
[2232]809                                        surf_def_h(0)%usws(m) * rmask(j,i,sr)
[3658]810                !$ACC ATOMIC
[2773]811                sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) +          &
[2232]812                                        surf_def_h(0)%vsws(m) * rmask(j,i,sr)
[3658]813                !$ACC ATOMIC
[2773]814                sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) +          &
[2232]815                                        surf_def_h(0)%ts(m)   * rmask(j,i,sr)
[3658]816#ifndef _OPENACC
[2232]817                IF ( humidity )  THEN
[2773]818                   sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) +     &
[2232]819                                            surf_def_h(0)%qs(m)   * rmask(j,i,sr)
820                ENDIF
821                IF ( passive_scalar )  THEN
[2773]822                   sums_l(nzb+13,pr_palm,tn) = sums_l(nzb+13,pr_palm,tn) +     &
[2232]823                                            surf_def_h(0)%ss(m)   * rmask(j,i,sr)
824                ENDIF
[3658]825#endif
[2773]826!
827!--             Summation of surface temperature.
[3658]828                !$ACC ATOMIC
[2773]829                sums_l(nzb+14,pr_palm,tn) = sums_l(nzb+14,pr_palm,tn)   +      &
830                                            surf_def_h(0)%pt_surface(m) *      &
831                                            rmask(j,i,sr)
[197]832             ENDIF
[2696]833             IF ( surf_lsm_h%end_index(j,i) >= surf_lsm_h%start_index(j,i) )  THEN
[2232]834                m = surf_lsm_h%start_index(j,i)
[3658]835                !$ACC ATOMIC
[2773]836                sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +            &
[2232]837                                        surf_lsm_h%us(m)   * rmask(j,i,sr)
[3658]838                !$ACC ATOMIC
[2773]839                sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) +          &
[2232]840                                        surf_lsm_h%usws(m) * rmask(j,i,sr)
[3658]841                !$ACC ATOMIC
[2773]842                sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) +          &
[2232]843                                        surf_lsm_h%vsws(m) * rmask(j,i,sr)
[3658]844                !$ACC ATOMIC
[2773]845                sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) +          &
[2232]846                                        surf_lsm_h%ts(m)   * rmask(j,i,sr)
[3658]847#ifndef _OPENACC
[2232]848                IF ( humidity )  THEN
[2773]849                   sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) +     &
[2232]850                                            surf_lsm_h%qs(m)   * rmask(j,i,sr)
851                ENDIF
852                IF ( passive_scalar )  THEN
[2773]853                   sums_l(nzb+13,pr_palm,tn) = sums_l(nzb+13,pr_palm,tn) +     &
[2232]854                                            surf_lsm_h%ss(m)   * rmask(j,i,sr)
855                ENDIF
[3658]856#endif
[2773]857!
858!--             Summation of surface temperature.
[3658]859                !$ACC ATOMIC
[2773]860                sums_l(nzb+14,pr_palm,tn) = sums_l(nzb+14,pr_palm,tn)   +      &
861                                            surf_lsm_h%pt_surface(m)    *      &
862                                            rmask(j,i,sr)
[1960]863             ENDIF
[2696]864             IF ( surf_usm_h%end_index(j,i) >= surf_usm_h%start_index(j,i) )  THEN
865                m = surf_usm_h%start_index(j,i)
[3658]866                !$ACC ATOMIC
[2773]867                sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +            &
[2232]868                                        surf_usm_h%us(m)   * rmask(j,i,sr)
[3658]869                !$ACC ATOMIC
[2773]870                sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) +          &
[2232]871                                        surf_usm_h%usws(m) * rmask(j,i,sr)
[3658]872                !$ACC ATOMIC
[2773]873                sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) +          &
[2232]874                                        surf_usm_h%vsws(m) * rmask(j,i,sr)
[3658]875                !$ACC ATOMIC
[2773]876                sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) +          &
[2232]877                                        surf_usm_h%ts(m)   * rmask(j,i,sr)
[3658]878#ifndef _OPENACC
[2232]879                IF ( humidity )  THEN
[2773]880                   sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) +     &
[2232]881                                            surf_usm_h%qs(m)   * rmask(j,i,sr)
882                ENDIF
883                IF ( passive_scalar )  THEN
[2773]884                   sums_l(nzb+13,pr_palm,tn) = sums_l(nzb+13,pr_palm,tn) +     &
[2232]885                                            surf_usm_h%ss(m)   * rmask(j,i,sr)
886                ENDIF
[3658]887#endif
[2773]888!
889!--             Summation of surface temperature.
[3658]890                !$ACC ATOMIC
[2773]891                sums_l(nzb+14,pr_palm,tn) = sums_l(nzb+14,pr_palm,tn)   +      &
892                                            surf_usm_h%pt_surface(m)    *      &
893                                            rmask(j,i,sr)
[2232]894             ENDIF
[1]895          ENDDO
896       ENDDO
[3658]897       !$ACC UPDATE &
898       !$ACC HOST(sums_l(:,3,tn), sums_l(:,8,tn), sums_l(:,9,tn)) &
899       !$ACC HOST(sums_l(:,10,tn), sums_l(:,40,tn), sums_l(:,33,tn)) &
900       !$ACC HOST(sums_l(:,38,tn)) &
901       !$ACC HOST(sums_l(nzb:nzb+4,pr_palm,tn), sums_l(nzb+14:nzb+14,pr_palm,tn))
[1]902
903!
[667]904!--    Computation of statistics when ws-scheme is not used. Else these
905!--    quantities are evaluated in the advection routines.
[1918]906       IF ( .NOT. ws_scheme_mom .OR. sr /= 0 .OR. simulated_time == 0.0_wp )   &
907       THEN
[667]908          !$OMP DO
909          DO  i = nxl, nxr
910             DO  j =  nys, nyn
[2232]911                DO  k = nzb, nzt+1
912                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
913
[667]914                   u2   = u(k,j,i)**2
915                   v2   = v(k,j,i)**2
916                   w2   = w(k,j,i)**2
917                   ust2 = ( u(k,j,i) - hom(k,1,1,sr) )**2
918                   vst2 = ( v(k,j,i) - hom(k,1,2,sr) )**2
919
[2232]920                   sums_l(k,30,tn) = sums_l(k,30,tn) + ust2 * rmask(j,i,sr)    &
921                                                            * flag
922                   sums_l(k,31,tn) = sums_l(k,31,tn) + vst2 * rmask(j,i,sr)    &
923                                                            * flag
924                   sums_l(k,32,tn) = sums_l(k,32,tn) + w2   * rmask(j,i,sr)    &
925                                                            * flag
[667]926!
[2026]927!--                Perturbation energy
[667]928
[1353]929                   sums_l(k,34,tn) = sums_l(k,34,tn) + 0.5_wp *                &
[2232]930                                  ( ust2 + vst2 + w2 )      * rmask(j,i,sr)    &
931                                                            * flag
[667]932                ENDDO
933             ENDDO
934          ENDDO
935       ENDIF
[2026]936!
937!--    Computaion of domain-averaged perturbation energy. Please note,
938!--    to prevent that perturbation energy is larger (even if only slightly)
939!--    than the total kinetic energy, calculation is based on deviations from
940!--    the horizontal mean, instead of spatial descretization of the advection
941!--    term.
942       !$OMP DO
[3658]943       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag, w2, ust2, vst2) &
944       !$ACC PRESENT(wall_flags_0, u, v, w, rmask, hom(:,1,1:2,sr)) &
945       !$ACC PRESENT(sums_l)
[2026]946       DO  i = nxl, nxr
947          DO  j =  nys, nyn
[2232]948             DO  k = nzb, nzt+1
949                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
950
[2026]951                w2   = w(k,j,i)**2
952                ust2 = ( u(k,j,i) - hom(k,1,1,sr) )**2
953                vst2 = ( v(k,j,i) - hom(k,1,2,sr) )**2
954                w2   = w(k,j,i)**2
[1241]955
[3658]956                !$ACC ATOMIC
[2026]957                sums_l(nzb+5,pr_palm,tn) = sums_l(nzb+5,pr_palm,tn)            &
[2232]958                                 + 0.5_wp * ( ust2 + vst2 + w2 )               &
959                                 * rmask(j,i,sr)                               &
960                                 * flag
[2026]961             ENDDO
962          ENDDO
963       ENDDO
[3658]964       !$ACC UPDATE HOST(sums_l(nzb+5:nzb+5,pr_palm,tn))
[2026]965
[667]966!
[1]967!--    Horizontally averaged profiles of the vertical fluxes
[667]968
[1]969       !$OMP DO
[3658]970       !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, l, m) &
971       !$ACC PRIVATE(ki, flag, ust, vst, pts) &
972       !$ACC PRESENT(kh, km, u, v, w, pt) &
973       !$ACC PRESENT(wall_flags_0, rmask, ddzu, rho_air_zw, hom(:,1,1:4,sr)) &
974       !$ACC PRESENT(heatflux_output_conversion, momentumflux_output_conversion) &
975       !$ACC PRESENT(surf_def_h(0:2), surf_lsm_h, surf_usm_h) &
976       !$ACC PRESENT(sums_l)
[1]977       DO  i = nxl, nxr
978          DO  j = nys, nyn
979!
980!--          Subgridscale fluxes (without Prandtl layer from k=nzb,
981!--          oterwise from k=nzb+1)
[132]982!--          NOTE: for simplicity, nzb_diff_s_inner is used below, although
[1]983!--          ----  strictly speaking the following k-loop would have to be
984!--                split up according to the staggered grid.
[132]985!--                However, this implies no error since staggered velocity
986!--                components are zero at the walls and inside buildings.
[2232]987!--          Flag 23 is used to mask surface fluxes as well as model-top fluxes,
988!--          which are added further below.
989             DO  k = nzb, nzt
990                flag = MERGE( 1.0_wp, 0.0_wp,                                  &
991                              BTEST( wall_flags_0(k,j,i), 23 ) ) *             &
992                       MERGE( 1.0_wp, 0.0_wp,                                  &
993                              BTEST( wall_flags_0(k,j,i), 9  ) )
[1]994!
995!--             Momentum flux w"u"
[3658]996                !$ACC ATOMIC
[1353]997                sums_l(k,12,tn) = sums_l(k,12,tn) - 0.25_wp * (                &
[1]998                               km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) &
999                                                           ) * (               &
1000                                   ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)     &
1001                                 + ( w(k,j,i)   - w(k,j,i-1) ) * ddx           &
[2037]1002                                                           ) * rmask(j,i,sr)   &
1003                                         * rho_air_zw(k)                       &
[2232]1004                                         * momentumflux_output_conversion(k)   &
1005                                         * flag
[1]1006!
1007!--             Momentum flux w"v"
[3658]1008                !$ACC ATOMIC
[1353]1009                sums_l(k,14,tn) = sums_l(k,14,tn) - 0.25_wp * (                &
[1]1010                               km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) &
1011                                                           ) * (               &
1012                                   ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)     &
1013                                 + ( w(k,j,i)   - w(k,j-1,i) ) * ddy           &
[2037]1014                                                           ) * rmask(j,i,sr)   &
1015                                         * rho_air_zw(k)                       &
[2232]1016                                         * momentumflux_output_conversion(k)   &
1017                                         * flag
[1]1018!
1019!--             Heat flux w"pt"
[3658]1020                !$ACC ATOMIC
[1]1021                sums_l(k,16,tn) = sums_l(k,16,tn)                              &
[1353]1022                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )&
[1]1023                                               * ( pt(k+1,j,i) - pt(k,j,i) )   &
[2037]1024                                               * rho_air_zw(k)                 &
1025                                               * heatflux_output_conversion(k) &
[2232]1026                                               * ddzu(k+1) * rmask(j,i,sr)     &
1027                                               * flag
[1]1028
1029!
[96]1030!--             Salinity flux w"sa"
[3658]1031#ifndef _OPENACC
[3294]1032                IF ( ocean_mode )  THEN
[96]1033                   sums_l(k,65,tn) = sums_l(k,65,tn)                           &
[1353]1034                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )&
[96]1035                                               * ( sa(k+1,j,i) - sa(k,j,i) )   &
[2232]1036                                               * ddzu(k+1) * rmask(j,i,sr)     &
1037                                               * flag
[96]1038                ENDIF
1039
1040!
[1]1041!--             Buoyancy flux, water flux (humidity flux) w"q"
[75]1042                IF ( humidity ) THEN
[1]1043                   sums_l(k,45,tn) = sums_l(k,45,tn)                           &
[1353]1044                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )&
[1]1045                                               * ( vpt(k+1,j,i) - vpt(k,j,i) ) &
[2037]1046                                               * rho_air_zw(k)                 &
1047                                               * heatflux_output_conversion(k) &
[2232]1048                                               * ddzu(k+1) * rmask(j,i,sr) * flag
[1]1049                   sums_l(k,48,tn) = sums_l(k,48,tn)                           &
[1353]1050                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )&
[1]1051                                               * ( q(k+1,j,i) - q(k,j,i) )     &
[2037]1052                                               * rho_air_zw(k)                 &
1053                                               * waterflux_output_conversion(k)&
[2232]1054                                               * ddzu(k+1) * rmask(j,i,sr) * flag
[1007]1055
[3274]1056                   IF ( bulk_cloud_model ) THEN
[1]1057                      sums_l(k,51,tn) = sums_l(k,51,tn)                        &
[1353]1058                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )&
[1]1059                                               * ( ( q(k+1,j,i) - ql(k+1,j,i) )&
1060                                                - ( q(k,j,i) - ql(k,j,i) ) )   &
[2037]1061                                               * rho_air_zw(k)                 &
1062                                               * waterflux_output_conversion(k)&
[2232]1063                                               * ddzu(k+1) * rmask(j,i,sr) * flag
[1]1064                   ENDIF
1065                ENDIF
1066
1067!
1068!--             Passive scalar flux
1069                IF ( passive_scalar )  THEN
[2270]1070                   sums_l(k,117,tn) = sums_l(k,117,tn)                         &
[1353]1071                                         - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )&
[2026]1072                                                  * ( s(k+1,j,i) - s(k,j,i) )  &
[2232]1073                                                  * ddzu(k+1) * rmask(j,i,sr)  &
1074                                                              * flag
[1]1075                ENDIF
[3658]1076#endif
[1]1077
1078             ENDDO
1079
1080!
1081!--          Subgridscale fluxes in the Prandtl layer
1082             IF ( use_surface_fluxes )  THEN
[2232]1083                DO  l = 0, 1
[3658]1084                   ! The original code using MERGE doesn't work with the PGI
1085                   ! compiler when running on the GPU.
[3676]1086                   ! This is submitted as a compiler Bug in PGI ticket TPR#26718
[3658]1087                   ! ki = MERGE( -1, 0, l == 0 )
1088                   ki = -1 + l
[2232]1089                   IF ( surf_def_h(l)%ns >= 1 )  THEN
[2696]1090                      DO  m = surf_def_h(l)%start_index(j,i),                  &
1091                              surf_def_h(l)%end_index(j,i)
[2232]1092                         k = surf_def_h(l)%k(m)
1093
[3658]1094                         !$ACC ATOMIC
[2232]1095                         sums_l(k+ki,12,tn) = sums_l(k+ki,12,tn) + &
1096                                    momentumflux_output_conversion(k+ki) * &
1097                                    surf_def_h(l)%usws(m) * rmask(j,i,sr)     ! w"u"
[3658]1098                         !$ACC ATOMIC
[2232]1099                         sums_l(k+ki,14,tn) = sums_l(k+ki,14,tn) + &
1100                                    momentumflux_output_conversion(k+ki) * &
1101                                    surf_def_h(l)%vsws(m) * rmask(j,i,sr)     ! w"v"
[3658]1102                         !$ACC ATOMIC
[2232]1103                         sums_l(k+ki,16,tn) = sums_l(k+ki,16,tn) + &
1104                                    heatflux_output_conversion(k+ki) * &
1105                                    surf_def_h(l)%shf(m)  * rmask(j,i,sr)     ! w"pt"
[3658]1106#if 0
[2232]1107                         sums_l(k+ki,58,tn) = sums_l(k+ki,58,tn) + &
1108                                    0.0_wp * rmask(j,i,sr)        ! u"pt"
1109                         sums_l(k+ki,61,tn) = sums_l(k+ki,61,tn) + &
1110                                    0.0_wp * rmask(j,i,sr)        ! v"pt"
[3658]1111#endif
1112#ifndef _OPENACC
[3294]1113                         IF ( ocean_mode )  THEN
[2232]1114                            sums_l(k+ki,65,tn) = sums_l(k+ki,65,tn) + &
1115                                       surf_def_h(l)%sasws(m) * rmask(j,i,sr)  ! w"sa"
1116                         ENDIF
1117                         IF ( humidity )  THEN
1118                            sums_l(k+ki,48,tn) = sums_l(k+ki,48,tn) +                     &
1119                                       waterflux_output_conversion(k+ki) *      &
1120                                       surf_def_h(l)%qsws(m) * rmask(j,i,sr)  ! w"q" (w"qv")
1121                            sums_l(k+ki,45,tn) = sums_l(k+ki,45,tn) + (                   &
1122                                       ( 1.0_wp + 0.61_wp * q(k+ki,j,i) ) *     &
1123                                       surf_def_h(l)%shf(m) + 0.61_wp * pt(k+ki,j,i) *      &
1124                                                  surf_def_h(l)%qsws(m) )                  &
1125                                       * heatflux_output_conversion(k+ki)
1126                            IF ( cloud_droplets )  THEN
1127                               sums_l(k+ki,45,tn) = sums_l(k+ki,45,tn) + (                &
1128                                         ( 1.0_wp + 0.61_wp * q(k+ki,j,i) -     &
1129                                           ql(k+ki,j,i) ) * surf_def_h(l)%shf(m) +          &
1130                                           0.61_wp * pt(k+ki,j,i) * surf_def_h(l)%qsws(m) ) &
1131                                          * heatflux_output_conversion(k+ki)
1132                            ENDIF
[3274]1133                            IF ( bulk_cloud_model )  THEN
[2232]1134!
1135!--                            Formula does not work if ql(k+ki) /= 0.0
1136                               sums_l(k+ki,51,tn) = sums_l(k+ki,51,tn) +                  &
1137                                          waterflux_output_conversion(k+ki) *   &
1138                                          surf_def_h(l)%qsws(m) * rmask(j,i,sr) ! w"q" (w"qv")
1139                            ENDIF
1140                         ENDIF
1141                         IF ( passive_scalar )  THEN
[2270]1142                            sums_l(k+ki,117,tn) = sums_l(k+ki,117,tn) +                     &
[2232]1143                                        surf_def_h(l)%ssws(m) * rmask(j,i,sr) ! w"s"
1144                         ENDIF
[3658]1145#endif
[2232]1146
1147                      ENDDO
1148
1149                   ENDIF
1150                ENDDO
[2696]1151                IF ( surf_lsm_h%end_index(j,i) >=                              &
1152                     surf_lsm_h%start_index(j,i) )  THEN
[2232]1153                   m = surf_lsm_h%start_index(j,i)
[3658]1154                   !$ACC ATOMIC
[2232]1155                   sums_l(nzb,12,tn) = sums_l(nzb,12,tn) + &
[2037]1156                                    momentumflux_output_conversion(nzb) * &
[2232]1157                                    surf_lsm_h%usws(m) * rmask(j,i,sr)     ! w"u"
[3658]1158                   !$ACC ATOMIC
[2232]1159                   sums_l(nzb,14,tn) = sums_l(nzb,14,tn) + &
[2037]1160                                    momentumflux_output_conversion(nzb) * &
[2232]1161                                    surf_lsm_h%vsws(m) * rmask(j,i,sr)     ! w"v"
[3658]1162                   !$ACC ATOMIC
[2232]1163                   sums_l(nzb,16,tn) = sums_l(nzb,16,tn) + &
[2037]1164                                    heatflux_output_conversion(nzb) * &
[2232]1165                                    surf_lsm_h%shf(m)  * rmask(j,i,sr)     ! w"pt"
[3658]1166#if 0
[2232]1167                   sums_l(nzb,58,tn) = sums_l(nzb,58,tn) + &
[1353]1168                                    0.0_wp * rmask(j,i,sr)        ! u"pt"
[2232]1169                   sums_l(nzb,61,tn) = sums_l(nzb,61,tn) + &
[1353]1170                                    0.0_wp * rmask(j,i,sr)        ! v"pt"
[3658]1171#endif
1172#ifndef _OPENACC
[3294]1173                   IF ( ocean_mode )  THEN
[2232]1174                      sums_l(nzb,65,tn) = sums_l(nzb,65,tn) + &
1175                                       surf_lsm_h%sasws(m) * rmask(j,i,sr)  ! w"sa"
1176                   ENDIF
1177                   IF ( humidity )  THEN
1178                      sums_l(nzb,48,tn) = sums_l(nzb,48,tn) +                     &
1179                                       waterflux_output_conversion(nzb) *      &
1180                                       surf_lsm_h%qsws(m) * rmask(j,i,sr)  ! w"q" (w"qv")
1181                      sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                   &
1182                                       ( 1.0_wp + 0.61_wp * q(nzb,j,i) ) *     &
1183                                       surf_lsm_h%shf(m) + 0.61_wp * pt(nzb,j,i) *      &
1184                                                  surf_lsm_h%qsws(m) )                  &
1185                                       * heatflux_output_conversion(nzb)
1186                      IF ( cloud_droplets )  THEN
1187                         sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                &
1188                                         ( 1.0_wp + 0.61_wp * q(nzb,j,i) -     &
1189                                           ql(nzb,j,i) ) * surf_lsm_h%shf(m) +          &
1190                                           0.61_wp * pt(nzb,j,i) * surf_lsm_h%qsws(m) ) &
1191                                          * heatflux_output_conversion(nzb)
1192                      ENDIF
[3274]1193                      IF ( bulk_cloud_model )  THEN
[2232]1194!
1195!--                      Formula does not work if ql(nzb) /= 0.0
1196                         sums_l(nzb,51,tn) = sums_l(nzb,51,tn) +                  &
1197                                          waterflux_output_conversion(nzb) *   &
1198                                          surf_lsm_h%qsws(m) * rmask(j,i,sr) ! w"q" (w"qv")
1199                      ENDIF
1200                   ENDIF
1201                   IF ( passive_scalar )  THEN
[2270]1202                      sums_l(nzb,117,tn) = sums_l(nzb,117,tn) +                     &
[2232]1203                                        surf_lsm_h%ssws(m) * rmask(j,i,sr) ! w"s"
1204                   ENDIF
[3658]1205#endif
[2232]1206
[96]1207                ENDIF
[2696]1208                IF ( surf_usm_h%end_index(j,i) >=                              &
1209                     surf_usm_h%start_index(j,i) )  THEN
[2232]1210                   m = surf_usm_h%start_index(j,i)
[3658]1211                   !$ACC ATOMIC
[2232]1212                   sums_l(nzb,12,tn) = sums_l(nzb,12,tn) + &
1213                                    momentumflux_output_conversion(nzb) * &
1214                                    surf_usm_h%usws(m) * rmask(j,i,sr)     ! w"u"
[3658]1215                   !$ACC ATOMIC
[2232]1216                   sums_l(nzb,14,tn) = sums_l(nzb,14,tn) + &
1217                                    momentumflux_output_conversion(nzb) * &
1218                                    surf_usm_h%vsws(m) * rmask(j,i,sr)     ! w"v"
[3658]1219                   !$ACC ATOMIC
[2232]1220                   sums_l(nzb,16,tn) = sums_l(nzb,16,tn) + &
1221                                    heatflux_output_conversion(nzb) * &
1222                                    surf_usm_h%shf(m)  * rmask(j,i,sr)     ! w"pt"
[3658]1223#if 0
[2232]1224                   sums_l(nzb,58,tn) = sums_l(nzb,58,tn) + &
1225                                    0.0_wp * rmask(j,i,sr)        ! u"pt"
1226                   sums_l(nzb,61,tn) = sums_l(nzb,61,tn) + &
1227                                    0.0_wp * rmask(j,i,sr)        ! v"pt"
[3658]1228#endif
1229#ifndef _OPENACC
[3294]1230                   IF ( ocean_mode )  THEN
[2232]1231                      sums_l(nzb,65,tn) = sums_l(nzb,65,tn) + &
1232                                       surf_usm_h%sasws(m) * rmask(j,i,sr)  ! w"sa"
1233                   ENDIF
1234                   IF ( humidity )  THEN
1235                      sums_l(nzb,48,tn) = sums_l(nzb,48,tn) +                     &
[2037]1236                                       waterflux_output_conversion(nzb) *      &
[2232]1237                                       surf_usm_h%qsws(m) * rmask(j,i,sr)  ! w"q" (w"qv")
1238                      sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                   &
[1353]1239                                       ( 1.0_wp + 0.61_wp * q(nzb,j,i) ) *     &
[2232]1240                                       surf_usm_h%shf(m) + 0.61_wp * pt(nzb,j,i) *      &
1241                                                  surf_usm_h%qsws(m) )                  &
[2037]1242                                       * heatflux_output_conversion(nzb)
[2232]1243                      IF ( cloud_droplets )  THEN
1244                         sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (                &
[1353]1245                                         ( 1.0_wp + 0.61_wp * q(nzb,j,i) -     &
[2232]1246                                           ql(nzb,j,i) ) * surf_usm_h%shf(m) +          &
1247                                           0.61_wp * pt(nzb,j,i) * surf_usm_h%qsws(m) ) &
[2037]1248                                          * heatflux_output_conversion(nzb)
[2232]1249                      ENDIF
[3274]1250                      IF ( bulk_cloud_model )  THEN
[1]1251!
[2232]1252!--                      Formula does not work if ql(nzb) /= 0.0
1253                         sums_l(nzb,51,tn) = sums_l(nzb,51,tn) +                  &
[2037]1254                                          waterflux_output_conversion(nzb) *   &
[2232]1255                                          surf_usm_h%qsws(m) * rmask(j,i,sr) ! w"q" (w"qv")
1256                      ENDIF
[1]1257                   ENDIF
[2232]1258                   IF ( passive_scalar )  THEN
[2270]1259                      sums_l(nzb,117,tn) = sums_l(nzb,117,tn) +                     &
[2232]1260                                        surf_usm_h%ssws(m) * rmask(j,i,sr) ! w"s"
1261                   ENDIF
[3658]1262#endif
[2232]1263
[1]1264                ENDIF
[2232]1265
[1]1266             ENDIF
1267
[3658]1268#ifndef _OPENACC
[1691]1269             IF ( .NOT. neutral )  THEN
[2696]1270                IF ( surf_def_h(0)%end_index(j,i) >=                           &
1271                     surf_def_h(0)%start_index(j,i) )  THEN
[2232]1272                   m = surf_def_h(0)%start_index(j,i)
[2696]1273                   sums_l(nzb,112,tn) = sums_l(nzb,112,tn) +                   &
[2232]1274                                        surf_def_h(0)%ol(m)  * rmask(j,i,sr) ! L
1275                ENDIF
[2696]1276                IF ( surf_lsm_h%end_index(j,i) >=                              &
1277                     surf_lsm_h%start_index(j,i) )  THEN
[2232]1278                   m = surf_lsm_h%start_index(j,i)
[2696]1279                   sums_l(nzb,112,tn) = sums_l(nzb,112,tn) +                   &
[2232]1280                                        surf_lsm_h%ol(m)  * rmask(j,i,sr) ! L
1281                ENDIF
[2696]1282                IF ( surf_usm_h%end_index(j,i) >=                              &
1283                     surf_usm_h%start_index(j,i) )  THEN
[2232]1284                   m = surf_usm_h%start_index(j,i)
[2696]1285                   sums_l(nzb,112,tn) = sums_l(nzb,112,tn) +                   &
[2232]1286                                        surf_usm_h%ol(m)  * rmask(j,i,sr) ! L
1287                ENDIF
[1691]1288             ENDIF
1289
[2296]1290             IF ( radiation )  THEN
[2696]1291                IF ( surf_def_h(0)%end_index(j,i) >=                           &
1292                     surf_def_h(0)%start_index(j,i) )  THEN
1293                   m = surf_def_h(0)%start_index(j,i)
1294                   sums_l(nzb,99,tn)  = sums_l(nzb,99,tn)  +                   &
1295                                        surf_def_h(0)%rad_net(m) * rmask(j,i,sr)
1296                   sums_l(nzb,100,tn) = sums_l(nzb,100,tn)  +                  &
1297                                        surf_def_h(0)%rad_lw_in(m) * rmask(j,i,sr)
1298                   sums_l(nzb,101,tn) = sums_l(nzb,101,tn)  +                  &
1299                                        surf_def_h(0)%rad_lw_out(m) * rmask(j,i,sr)
1300                   sums_l(nzb,102,tn) = sums_l(nzb,102,tn)  +                  &
1301                                        surf_def_h(0)%rad_sw_in(m) * rmask(j,i,sr)
1302                   sums_l(nzb,103,tn) = sums_l(nzb,103,tn)  +                  &
1303                                        surf_def_h(0)%rad_sw_out(m) * rmask(j,i,sr)
1304                ENDIF
1305                IF ( surf_lsm_h%end_index(j,i) >=                              &
1306                     surf_lsm_h%start_index(j,i) )  THEN
1307                   m = surf_lsm_h%start_index(j,i)
1308                   sums_l(nzb,99,tn)  = sums_l(nzb,99,tn)  +                   &
1309                                        surf_lsm_h%rad_net(m) * rmask(j,i,sr)
1310                   sums_l(nzb,100,tn) = sums_l(nzb,100,tn)  +                  &
1311                                        surf_lsm_h%rad_lw_in(m) * rmask(j,i,sr)
1312                   sums_l(nzb,101,tn) = sums_l(nzb,101,tn)  +                  &
1313                                        surf_lsm_h%rad_lw_out(m) * rmask(j,i,sr)
1314                   sums_l(nzb,102,tn) = sums_l(nzb,102,tn)  +                  &
1315                                        surf_lsm_h%rad_sw_in(m) * rmask(j,i,sr)
1316                   sums_l(nzb,103,tn) = sums_l(nzb,103,tn)  +                  &
1317                                        surf_lsm_h%rad_sw_out(m) * rmask(j,i,sr)
1318                ENDIF
1319                IF ( surf_usm_h%end_index(j,i) >=                              &
1320                     surf_usm_h%start_index(j,i) )  THEN
1321                   m = surf_usm_h%start_index(j,i)
1322                   sums_l(nzb,99,tn)  = sums_l(nzb,99,tn)  +                   &
1323                                        surf_usm_h%rad_net(m) * rmask(j,i,sr)
1324                   sums_l(nzb,100,tn) = sums_l(nzb,100,tn)  +                  &
1325                                        surf_usm_h%rad_lw_in(m) * rmask(j,i,sr)
1326                   sums_l(nzb,101,tn) = sums_l(nzb,101,tn)  +                  &
1327                                        surf_usm_h%rad_lw_out(m) * rmask(j,i,sr)
1328                   sums_l(nzb,102,tn) = sums_l(nzb,102,tn)  +                  &
1329                                        surf_usm_h%rad_sw_in(m) * rmask(j,i,sr)
1330                   sums_l(nzb,103,tn) = sums_l(nzb,103,tn)  +                  &
1331                                        surf_usm_h%rad_sw_out(m) * rmask(j,i,sr)
1332                ENDIF
[1585]1333
1334#if defined ( __rrtmg )
1335                IF ( radiation_scheme == 'rrtmg' )  THEN
[2696]1336
1337                   IF ( surf_def_h(0)%end_index(j,i) >=                        &
1338                        surf_def_h(0)%start_index(j,i) )  THEN
1339                      m = surf_def_h(0)%start_index(j,i)
1340                      sums_l(nzb,108,tn)  = sums_l(nzb,108,tn)  +              &
[2753]1341                                   surf_def_h(0)%rrtm_aldif(0,m) * rmask(j,i,sr)
[2696]1342                      sums_l(nzb,109,tn) = sums_l(nzb,109,tn)  +               &
[2753]1343                                   surf_def_h(0)%rrtm_aldir(0,m) * rmask(j,i,sr)
[2696]1344                      sums_l(nzb,110,tn) = sums_l(nzb,110,tn)  +               &
[2753]1345                                   surf_def_h(0)%rrtm_asdif(0,m) * rmask(j,i,sr)
[2696]1346                      sums_l(nzb,111,tn) = sums_l(nzb,111,tn)  +               &
[2753]1347                                   surf_def_h(0)%rrtm_asdir(0,m) * rmask(j,i,sr)
[2696]1348                   ENDIF
1349                   IF ( surf_lsm_h%end_index(j,i) >=                           &
1350                        surf_lsm_h%start_index(j,i) )  THEN
1351                      m = surf_lsm_h%start_index(j,i)
1352                      sums_l(nzb,108,tn)  = sums_l(nzb,108,tn)  +              &
[2753]1353                               SUM( surf_lsm_h%frac(:,m) *                     &
1354                                    surf_lsm_h%rrtm_aldif(:,m) ) * rmask(j,i,sr)
[2696]1355                      sums_l(nzb,109,tn) = sums_l(nzb,109,tn)  +               &
[2753]1356                               SUM( surf_lsm_h%frac(:,m) *                     &
1357                                    surf_lsm_h%rrtm_aldir(:,m) ) * rmask(j,i,sr)
[2696]1358                      sums_l(nzb,110,tn) = sums_l(nzb,110,tn)  +               &
[2753]1359                               SUM( surf_lsm_h%frac(:,m) *                     &
1360                                    surf_lsm_h%rrtm_asdif(:,m) ) * rmask(j,i,sr)
[2696]1361                      sums_l(nzb,111,tn) = sums_l(nzb,111,tn)  +               &
[2753]1362                               SUM( surf_lsm_h%frac(:,m) *                     &
1363                                    surf_lsm_h%rrtm_asdir(:,m) ) * rmask(j,i,sr)
[2696]1364                   ENDIF
1365                   IF ( surf_usm_h%end_index(j,i) >=                           &
1366                        surf_usm_h%start_index(j,i) )  THEN
1367                      m = surf_usm_h%start_index(j,i)
1368                      sums_l(nzb,108,tn)  = sums_l(nzb,108,tn)  +              &
[2753]1369                               SUM( surf_usm_h%frac(:,m) *                     &
1370                                    surf_usm_h%rrtm_aldif(:,m) ) * rmask(j,i,sr)
[2696]1371                      sums_l(nzb,109,tn) = sums_l(nzb,109,tn)  +               &
[2753]1372                               SUM( surf_usm_h%frac(:,m) *                     &
1373                                    surf_usm_h%rrtm_aldir(:,m) ) * rmask(j,i,sr)
[2696]1374                      sums_l(nzb,110,tn) = sums_l(nzb,110,tn)  +               &
[2753]1375                               SUM( surf_usm_h%frac(:,m) *                     &
1376                                    surf_usm_h%rrtm_asdif(:,m) ) * rmask(j,i,sr)
[2696]1377                      sums_l(nzb,111,tn) = sums_l(nzb,111,tn)  +               &
[2753]1378                               SUM( surf_usm_h%frac(:,m) *                     &
1379                                    surf_usm_h%rrtm_asdir(:,m) ) * rmask(j,i,sr)
[2696]1380                   ENDIF
1381
[1585]1382                ENDIF
1383#endif
[1551]1384             ENDIF
[3658]1385#endif
[1]1386!
[19]1387!--          Subgridscale fluxes at the top surface
1388             IF ( use_top_fluxes )  THEN
[2232]1389                m = surf_def_h(2)%start_index(j,i)
[3658]1390                !$ACC ATOMIC
1391                sums_l(nzt,12,tn) = sums_l(nzt,12,tn) + &
1392                                    momentumflux_output_conversion(nzt) * &
[2232]1393                                    surf_def_h(2)%usws(m) * rmask(j,i,sr)    ! w"u"
[3658]1394                !$ACC ATOMIC
1395                sums_l(nzt+1,12,tn) = sums_l(nzt+1,12,tn) + &
1396                                    momentumflux_output_conversion(nzt+1) * &
1397                                    surf_def_h(2)%usws(m) * rmask(j,i,sr)    ! w"u"
1398                !$ACC ATOMIC
1399                sums_l(nzt,14,tn) = sums_l(nzt,14,tn) + &
1400                                    momentumflux_output_conversion(nzt) * &
[2232]1401                                    surf_def_h(2)%vsws(m) * rmask(j,i,sr)    ! w"v"
[3658]1402                !$ACC ATOMIC
1403                sums_l(nzt+1,14,tn) = sums_l(nzt+1,14,tn) + &
1404                                    momentumflux_output_conversion(nzt+1) * &
1405                                    surf_def_h(2)%vsws(m) * rmask(j,i,sr)    ! w"v"
1406                !$ACC ATOMIC
1407                sums_l(nzt,16,tn) = sums_l(nzt,16,tn) + &
1408                                    heatflux_output_conversion(nzt) * &
[2232]1409                                    surf_def_h(2)%shf(m)  * rmask(j,i,sr)   ! w"pt"
[3658]1410                !$ACC ATOMIC
1411                sums_l(nzt+1,16,tn) = sums_l(nzt+1,16,tn) + &
1412                                    heatflux_output_conversion(nzt+1) * &
1413                                    surf_def_h(2)%shf(m)  * rmask(j,i,sr)   ! w"pt"
1414#if 0
[550]1415                sums_l(nzt:nzt+1,58,tn) = sums_l(nzt:nzt+1,58,tn) + &
[1353]1416                                    0.0_wp * rmask(j,i,sr)        ! u"pt"
[550]1417                sums_l(nzt:nzt+1,61,tn) = sums_l(nzt:nzt+1,61,tn) + &
[1353]1418                                    0.0_wp * rmask(j,i,sr)        ! v"pt"
[3658]1419#endif
1420#ifndef _OPENACC
[3294]1421                IF ( ocean_mode )  THEN
[96]1422                   sums_l(nzt,65,tn) = sums_l(nzt,65,tn) + &
[2232]1423                                       surf_def_h(2)%sasws(m) * rmask(j,i,sr)  ! w"sa"
[96]1424                ENDIF
[75]1425                IF ( humidity )  THEN
[1353]1426                   sums_l(nzt,48,tn) = sums_l(nzt,48,tn) +                     &
[2037]1427                                       waterflux_output_conversion(nzt) *      &
[2232]1428                                       surf_def_h(2)%qsws(m) * rmask(j,i,sr) ! w"q" (w"qv")
[1353]1429                   sums_l(nzt,45,tn) = sums_l(nzt,45,tn) + (                   &
1430                                       ( 1.0_wp + 0.61_wp * q(nzt,j,i) ) *     &
[2232]1431                                       surf_def_h(2)%shf(m) +                  &
1432                                       0.61_wp * pt(nzt,j,i) *    &
1433                                       surf_def_h(2)%qsws(m) )      &
[2037]1434                                       * heatflux_output_conversion(nzt)
[1007]1435                   IF ( cloud_droplets )  THEN
[1353]1436                      sums_l(nzt,45,tn) = sums_l(nzt,45,tn) + (                &
1437                                          ( 1.0_wp + 0.61_wp * q(nzt,j,i) -    &
[2232]1438                                            ql(nzt,j,i) ) *                    &
1439                                            surf_def_h(2)%shf(m) +             &
1440                                           0.61_wp * pt(nzt,j,i) *             &
1441                                           surf_def_h(2)%qsws(m) )&
[2037]1442                                           * heatflux_output_conversion(nzt)
[1007]1443                   ENDIF
[3274]1444                   IF ( bulk_cloud_model )  THEN
[19]1445!
1446!--                   Formula does not work if ql(nzb) /= 0.0
1447                      sums_l(nzt,51,tn) = sums_l(nzt,51,tn) + &   ! w"q" (w"qv")
[2037]1448                                          waterflux_output_conversion(nzt) *   &
[2232]1449                                          surf_def_h(2)%qsws(m) * rmask(j,i,sr)
[19]1450                   ENDIF
1451                ENDIF
1452                IF ( passive_scalar )  THEN
[2270]1453                   sums_l(nzt,117,tn) = sums_l(nzt,117,tn) + &
[2232]1454                                        surf_def_h(2)%ssws(m) * rmask(j,i,sr) ! w"s"
[19]1455                ENDIF
[3658]1456#endif
[19]1457             ENDIF
1458
1459!
[1]1460!--          Resolved fluxes (can be computed for all horizontal points)
[132]1461!--          NOTE: for simplicity, nzb_s_inner is used below, although strictly
[1]1462!--          ----  speaking the following k-loop would have to be split up and
1463!--                rearranged according to the staggered grid.
[2232]1464             DO  k = nzb, nzt
1465                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) )
[1353]1466                ust = 0.5_wp * ( u(k,j,i)   - hom(k,1,1,sr) +                  &
1467                                 u(k+1,j,i) - hom(k+1,1,1,sr) )
1468                vst = 0.5_wp * ( v(k,j,i)   - hom(k,1,2,sr) +                  &
1469                                 v(k+1,j,i) - hom(k+1,1,2,sr) )
1470                pts = 0.5_wp * ( pt(k,j,i)   - hom(k,1,4,sr) +                 &
1471                                 pt(k+1,j,i) - hom(k+1,1,4,sr) )
[667]1472
[1]1473!--             Higher moments
[3658]1474                !$ACC ATOMIC
[1353]1475                sums_l(k,35,tn) = sums_l(k,35,tn) + pts * w(k,j,i)**2 *        &
[2232]1476                                                    rmask(j,i,sr) * flag
[3658]1477                !$ACC ATOMIC
[1353]1478                sums_l(k,36,tn) = sums_l(k,36,tn) + pts**2 * w(k,j,i) *        &
[2232]1479                                                    rmask(j,i,sr) * flag
[1]1480
1481!
[96]1482!--             Salinity flux and density (density does not belong to here,
[97]1483!--             but so far there is no other suitable place to calculate)
[3658]1484#ifndef _OPENACC
[3294]1485                IF ( ocean_mode )  THEN
[1567]1486                   IF( .NOT. ws_scheme_sca .OR. sr /= 0 )  THEN
[1353]1487                      pts = 0.5_wp * ( sa(k,j,i)   - hom(k,1,23,sr) +          &
1488                                       sa(k+1,j,i) - hom(k+1,1,23,sr) )
1489                      sums_l(k,66,tn) = sums_l(k,66,tn) + pts * w(k,j,i) *     &
[2232]1490                                        rmask(j,i,sr) * flag
[667]1491                   ENDIF
[2232]1492                   sums_l(k,64,tn) = sums_l(k,64,tn) + rho_ocean(k,j,i) *      &
1493                                                       rmask(j,i,sr) * flag
[1353]1494                   sums_l(k,71,tn) = sums_l(k,71,tn) + prho(k,j,i) *           &
[2232]1495                                                       rmask(j,i,sr) * flag
[96]1496                ENDIF
1497
1498!
[1053]1499!--             Buoyancy flux, water flux, humidity flux, liquid water
1500!--             content, rain drop concentration and rain water content
[75]1501                IF ( humidity )  THEN
[3274]1502                   IF ( bulk_cloud_model .OR. cloud_droplets )  THEN
[1353]1503                      pts = 0.5_wp * ( vpt(k,j,i)   - hom(k,1,44,sr) +         &
[1007]1504                                    vpt(k+1,j,i) - hom(k+1,1,44,sr) )
[1353]1505                      sums_l(k,46,tn) = sums_l(k,46,tn) + pts * w(k,j,i) *     &
[4039]1506                                               rho_air_zw(k) *                 &
[2037]1507                                               heatflux_output_conversion(k) * &
[2232]1508                                                          rmask(j,i,sr) * flag
1509                      sums_l(k,54,tn) = sums_l(k,54,tn) + ql(k,j,i) * rmask(j,i,sr) &
1510                                                                    * flag
[1822]1511
[1053]1512                      IF ( .NOT. cloud_droplets )  THEN
[1353]1513                         pts = 0.5_wp *                                        &
[1115]1514                              ( ( q(k,j,i) - ql(k,j,i) ) -                     &
1515                              hom(k,1,42,sr) +                                 &
1516                              ( q(k+1,j,i) - ql(k+1,j,i) ) -                   &
[1053]1517                              hom(k+1,1,42,sr) )
[1115]1518                         sums_l(k,52,tn) = sums_l(k,52,tn) + pts * w(k,j,i) *  &
[4039]1519                                             rho_air_zw(k) *                   &
[2037]1520                                             waterflux_output_conversion(k) *  &
[2232]1521                                                             rmask(j,i,sr)  *  &
1522                                                             flag
[1822]1523                         sums_l(k,75,tn) = sums_l(k,75,tn) + qc(k,j,i) *       &
[2232]1524                                                             rmask(j,i,sr) *   &
1525                                                             flag
[1822]1526                         sums_l(k,76,tn) = sums_l(k,76,tn) + prr(k,j,i) *      &
[2232]1527                                                             rmask(j,i,sr) *   &
1528                                                             flag
[2292]1529                         IF ( microphysics_morrison )  THEN
1530                            sums_l(k,123,tn) = sums_l(k,123,tn) + nc(k,j,i) *  &
1531                                                                rmask(j,i,sr) *&
1532                                                                flag
1533                         ENDIF
[1822]1534                         IF ( microphysics_seifert )  THEN
1535                            sums_l(k,73,tn) = sums_l(k,73,tn) + nr(k,j,i) *    &
[2232]1536                                                                rmask(j,i,sr) *&
1537                                                                flag 
[1822]1538                            sums_l(k,74,tn) = sums_l(k,74,tn) + qr(k,j,i) *    &
[2232]1539                                                                rmask(j,i,sr) *&
1540                                                                flag
[1053]1541                         ENDIF
1542                      ENDIF
[1822]1543
[1007]1544                   ELSE
[1567]1545                      IF( .NOT. ws_scheme_sca .OR. sr /= 0 )  THEN
[1353]1546                         pts = 0.5_wp * ( vpt(k,j,i)   - hom(k,1,44,sr) +      &
1547                                          vpt(k+1,j,i) - hom(k+1,1,44,sr) )
1548                         sums_l(k,46,tn) = sums_l(k,46,tn) + pts * w(k,j,i) *  &
[4039]1549                                              rho_air_zw(k) *                  &
[2037]1550                                              heatflux_output_conversion(k) *  &
[2232]1551                                                             rmask(j,i,sr)  *  &
1552                                                             flag
[1567]1553                      ELSE IF ( ws_scheme_sca .AND. sr == 0 )  THEN
[2037]1554                         sums_l(k,46,tn) = ( ( 1.0_wp + 0.61_wp *              & 
1555                                               hom(k,1,41,sr) ) *              &
1556                                             sums_l(k,17,tn) +                 &
1557                                             0.61_wp * hom(k,1,4,sr) *         &
1558                                             sums_l(k,49,tn)                   &
[2232]1559                                           ) * heatflux_output_conversion(k) * &
1560                                               flag
[1007]1561                      END IF
1562                   END IF
[1]1563                ENDIF
1564!
1565!--             Passive scalar flux
[1353]1566                IF ( passive_scalar .AND. ( .NOT. ws_scheme_sca                &
[1567]1567                     .OR. sr /= 0 ) )  THEN
[2270]1568                   pts = 0.5_wp * ( s(k,j,i)   - hom(k,1,115,sr) +             &
1569                                    s(k+1,j,i) - hom(k+1,1,115,sr) )
1570                   sums_l(k,114,tn) = sums_l(k,114,tn) + pts * w(k,j,i) *      &
[2232]1571                                                       rmask(j,i,sr) * flag
[1]1572                ENDIF
[3658]1573#endif
[1]1574
1575!
1576!--             Energy flux w*e*
[667]1577!--             has to be adjusted
[3658]1578                !$ACC ATOMIC
[1353]1579                sums_l(k,37,tn) = sums_l(k,37,tn) + w(k,j,i) * 0.5_wp *        &
1580                                             ( ust**2 + vst**2 + w(k,j,i)**2 ) &
[2674]1581                                           * rho_air_zw(k)                     &
[2037]1582                                           * momentumflux_output_conversion(k) &
[2232]1583                                           * rmask(j,i,sr) * flag
[1]1584             ENDDO
1585          ENDDO
1586       ENDDO
[2232]1587       !$OMP END PARALLEL
[3658]1588
1589       !$ACC UPDATE &
1590       !$ACC HOST(sums_l(:,12,tn), sums_l(:,14,tn), sums_l(:,16,tn)) &
1591       !$ACC HOST(sums_l(:,35,tn), sums_l(:,36,tn), sums_l(:,37,tn))
[709]1592!
[2232]1593!--    Treat land-surface quantities according to new wall model structure.
1594       IF ( land_surface )  THEN
1595          tn = 0
1596          !$OMP PARALLEL PRIVATE( i, j, m, tn )
1597          !$ tn = omp_get_thread_num()
1598          !$OMP DO
1599          DO  m = 1, surf_lsm_h%ns
1600             i = surf_lsm_h%i(m)
1601             j = surf_lsm_h%j(m)
1602       
1603             IF ( i >= nxl  .AND.  i <= nxr  .AND.                             &
1604                  j >= nys  .AND.  j <= nyn )  THEN
[2270]1605                sums_l(nzb,93,tn)  = sums_l(nzb,93,tn) + surf_lsm_h%ghf(m)
1606                sums_l(nzb,94,tn)  = sums_l(nzb,94,tn) + surf_lsm_h%qsws_liq(m)
1607                sums_l(nzb,95,tn)  = sums_l(nzb,95,tn) + surf_lsm_h%qsws_soil(m)
1608                sums_l(nzb,96,tn)  = sums_l(nzb,96,tn) + surf_lsm_h%qsws_veg(m)
1609                sums_l(nzb,97,tn)  = sums_l(nzb,97,tn) + surf_lsm_h%r_a(m)
1610                sums_l(nzb,98,tn) = sums_l(nzb,98,tn)+ surf_lsm_h%r_s(m)
[2232]1611             ENDIF
1612          ENDDO
1613          !$OMP END PARALLEL
1614
1615          tn = 0
1616          !$OMP PARALLEL PRIVATE( i, j, k, m, tn )
1617          !$ tn = omp_get_thread_num()
1618          !$OMP DO
1619          DO  m = 1, surf_lsm_h%ns
1620
1621             i = surf_lsm_h%i(m)           
1622             j = surf_lsm_h%j(m)
1623
1624             IF ( i >= nxl  .AND.  i <= nxr  .AND.                             &
1625                  j >= nys  .AND.  j <= nyn )  THEN
1626
1627                DO  k = nzb_soil, nzt_soil
1628                   sums_l(k,89,tn)  = sums_l(k,89,tn)  + t_soil_h%var_2d(k,m)  &
1629                                      * rmask(j,i,sr)
1630                   sums_l(k,91,tn)  = sums_l(k,91,tn)  + m_soil_h%var_2d(k,m)  &
1631                                      * rmask(j,i,sr)
1632                ENDDO
1633             ENDIF
1634          ENDDO
1635          !$OMP END PARALLEL
1636       ENDIF
1637!
[709]1638!--    For speed optimization fluxes which have been computed in part directly
1639!--    inside the WS advection routines are treated seperatly
1640!--    Momentum fluxes first:
[2232]1641
1642       tn = 0
1643       !$OMP PARALLEL PRIVATE( i, j, k, tn, flag )
1644       !$ tn = omp_get_thread_num()
[743]1645       IF ( .NOT. ws_scheme_mom .OR. sr /= 0  )  THEN
[2232]1646          !$OMP DO
1647          DO  i = nxl, nxr
1648             DO  j = nys, nyn
1649                DO  k = nzb, nzt
[1007]1650!
[2232]1651!--                Flag 23 is used to mask surface fluxes as well as model-top
1652!--                fluxes, which are added further below.
1653                   flag = MERGE( 1.0_wp, 0.0_wp,                               &
1654                                 BTEST( wall_flags_0(k,j,i), 23 ) ) *          &
1655                          MERGE( 1.0_wp, 0.0_wp,                               &
1656                                 BTEST( wall_flags_0(k,j,i), 9  ) )
1657
1658                   ust = 0.5_wp * ( u(k,j,i)   - hom(k,1,1,sr) +               &
1659                                    u(k+1,j,i) - hom(k+1,1,1,sr) )
1660                   vst = 0.5_wp * ( v(k,j,i)   - hom(k,1,2,sr) +               &
1661                                    v(k+1,j,i) - hom(k+1,1,2,sr) )
[667]1662!
[2232]1663!--                Momentum flux w*u*
1664                   sums_l(k,13,tn) = sums_l(k,13,tn) + 0.5_wp *                &
1665                                                     ( w(k,j,i-1) + w(k,j,i) ) &
[2674]1666                                           * rho_air_zw(k)                     &
[2232]1667                                           * momentumflux_output_conversion(k) &
1668                                                     * ust * rmask(j,i,sr)     &
1669                                                           * flag
1670!
1671!--                Momentum flux w*v*
1672                   sums_l(k,15,tn) = sums_l(k,15,tn) + 0.5_wp *                &
1673                                                     ( w(k,j-1,i) + w(k,j,i) ) &
[2674]1674                                           * rho_air_zw(k)                     &
[2232]1675                                           * momentumflux_output_conversion(k) &
1676                                                     * vst * rmask(j,i,sr)     &
1677                                                           * flag
1678                ENDDO
1679             ENDDO
1680          ENDDO
[1]1681
[667]1682       ENDIF
[1567]1683       IF ( .NOT. ws_scheme_sca .OR. sr /= 0 )  THEN
[2232]1684          !$OMP DO
1685          DO  i = nxl, nxr
1686             DO  j = nys, nyn
1687                DO  k = nzb, nzt
1688                   flag = MERGE( 1.0_wp, 0.0_wp,                               &
1689                                 BTEST( wall_flags_0(k,j,i), 23 ) ) *          &
1690                          MERGE( 1.0_wp, 0.0_wp,                               &
1691                                 BTEST( wall_flags_0(k,j,i), 9  ) )
[709]1692!
[2232]1693!--                Vertical heat flux
1694                   sums_l(k,17,tn) = sums_l(k,17,tn) + 0.5_wp *                &
[1353]1695                           ( pt(k,j,i)   - hom(k,1,4,sr) +                     &
1696                             pt(k+1,j,i) - hom(k+1,1,4,sr) )                   &
[4039]1697                           * rho_air_zw(k)                                     &
[2037]1698                           * heatflux_output_conversion(k)                     &
[2232]1699                           * w(k,j,i) * rmask(j,i,sr) * flag
1700                   IF ( humidity )  THEN
1701                      pts = 0.5_wp * ( q(k,j,i)   - hom(k,1,41,sr) +           &
[1353]1702                                      q(k+1,j,i) - hom(k+1,1,41,sr) )
[2232]1703                      sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) *     &
[4039]1704                                       rho_air_zw(k) *                         &
[2037]1705                                       waterflux_output_conversion(k) *        &
[2232]1706                                       rmask(j,i,sr) * flag
1707                   ENDIF
1708                   IF ( passive_scalar )  THEN
[2270]1709                      pts = 0.5_wp * ( s(k,j,i)   - hom(k,1,115,sr) +           &
1710                                      s(k+1,j,i) - hom(k+1,1,115,sr) )
1711                      sums_l(k,114,tn) = sums_l(k,114,tn) + pts * w(k,j,i) *    &
[2232]1712                                        rmask(j,i,sr) * flag
1713                   ENDIF
1714                ENDDO
1715             ENDDO
1716          ENDDO
[667]1717
1718       ENDIF
1719
[1]1720!
[97]1721!--    Density at top follows Neumann condition
[3294]1722       IF ( ocean_mode )  THEN
[388]1723          sums_l(nzt+1,64,tn) = sums_l(nzt,64,tn)
1724          sums_l(nzt+1,71,tn) = sums_l(nzt,71,tn)
1725       ENDIF
[97]1726
1727!
[1]1728!--    Divergence of vertical flux of resolved scale energy and pressure
[106]1729!--    fluctuations as well as flux of pressure fluctuation itself (68).
1730!--    First calculate the products, then the divergence.
[1]1731!--    Calculation is time consuming. Do it only, if profiles shall be plotted.
[1691]1732       IF ( hom(nzb+1,2,55,0) /= 0.0_wp  .OR.  hom(nzb+1,2,68,0) /= 0.0_wp )   &
1733       THEN
[1353]1734          sums_ll = 0.0_wp  ! local array
[1]1735
1736          !$OMP DO
1737          DO  i = nxl, nxr
1738             DO  j = nys, nyn
[2232]1739                DO  k = nzb+1, nzt
1740                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
[1]1741
[1353]1742                   sums_ll(k,1) = sums_ll(k,1) + 0.5_wp * w(k,j,i) * (         &
[1652]1743                  ( 0.25_wp * ( u(k,j,i)+u(k+1,j,i)+u(k,j,i+1)+u(k+1,j,i+1) )  &
1744                            - 0.5_wp * ( hom(k,1,1,sr) + hom(k+1,1,1,sr) ) )**2&
1745                + ( 0.25_wp * ( v(k,j,i)+v(k+1,j,i)+v(k,j+1,i)+v(k+1,j+1,i) )  &
[1654]1746                            - 0.5_wp * ( hom(k,1,2,sr) + hom(k+1,1,2,sr) ) )**2&
[2232]1747                + w(k,j,i)**2                                        ) * flag
[1]1748
[1353]1749                   sums_ll(k,2) = sums_ll(k,2) + 0.5_wp * w(k,j,i)             &
[2252]1750                                       * ( ( p(k,j,i) + p(k+1,j,i) )           &
1751                                         / momentumflux_output_conversion(k) ) &
1752                                       * flag
[1]1753
1754                ENDDO
1755             ENDDO
1756          ENDDO
[1353]1757          sums_ll(0,1)     = 0.0_wp    ! because w is zero at the bottom
1758          sums_ll(nzt+1,1) = 0.0_wp
1759          sums_ll(0,2)     = 0.0_wp
1760          sums_ll(nzt+1,2) = 0.0_wp
[1]1761
[678]1762          DO  k = nzb+1, nzt
[1]1763             sums_l(k,55,tn) = ( sums_ll(k,1) - sums_ll(k-1,1) ) * ddzw(k)
1764             sums_l(k,56,tn) = ( sums_ll(k,2) - sums_ll(k-1,2) ) * ddzw(k)
[106]1765             sums_l(k,68,tn) = sums_ll(k,2)
[1]1766          ENDDO
1767          sums_l(nzb,55,tn) = sums_l(nzb+1,55,tn)
1768          sums_l(nzb,56,tn) = sums_l(nzb+1,56,tn)
[1353]1769          sums_l(nzb,68,tn) = 0.0_wp    ! because w* = 0 at nzb
[1]1770
1771       ENDIF
1772
1773!
[106]1774!--    Divergence of vertical flux of SGS TKE and the flux itself (69)
[1691]1775       IF ( hom(nzb+1,2,57,0) /= 0.0_wp  .OR.  hom(nzb+1,2,69,0) /= 0.0_wp )   &
1776       THEN
[1]1777          !$OMP DO
1778          DO  i = nxl, nxr
1779             DO  j = nys, nyn
[2232]1780                DO  k = nzb+1, nzt
[1]1781
[2232]1782                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
1783
[1353]1784                   sums_l(k,57,tn) = sums_l(k,57,tn) - 0.5_wp * (              &
[1]1785                   (km(k,j,i)+km(k+1,j,i)) * (e(k+1,j,i)-e(k,j,i)) * ddzu(k+1) &
1786                 - (km(k-1,j,i)+km(k,j,i)) * (e(k,j,i)-e(k-1,j,i)) * ddzu(k)   &
[2232]1787                                                                ) * ddzw(k)    &
1788                                                                  * flag
[1]1789
[1353]1790                   sums_l(k,69,tn) = sums_l(k,69,tn) - 0.5_wp * (              &
[106]1791                   (km(k,j,i)+km(k+1,j,i)) * (e(k+1,j,i)-e(k,j,i)) * ddzu(k+1) &
[2232]1792                                                                )  * flag
[106]1793
[1]1794                ENDDO
1795             ENDDO
1796          ENDDO
1797          sums_l(nzb,57,tn) = sums_l(nzb+1,57,tn)
[106]1798          sums_l(nzb,69,tn) = sums_l(nzb+1,69,tn)
[1]1799
1800       ENDIF
1801
1802!
1803!--    Horizontal heat fluxes (subgrid, resolved, total).
1804!--    Do it only, if profiles shall be plotted.
[1353]1805       IF ( hom(nzb+1,2,58,0) /= 0.0_wp ) THEN
[1]1806
1807          !$OMP DO
1808          DO  i = nxl, nxr
1809             DO  j = nys, nyn
[2232]1810                DO  k = nzb+1, nzt
1811                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
[1]1812!
1813!--                Subgrid horizontal heat fluxes u"pt", v"pt"
[1353]1814                   sums_l(k,58,tn) = sums_l(k,58,tn) - 0.5_wp *                &
[1]1815                                                   ( kh(k,j,i) + kh(k,j,i-1) ) &
1816                                                 * ( pt(k,j,i-1) - pt(k,j,i) ) &
[2037]1817                                               * rho_air_zw(k)                 &
1818                                               * heatflux_output_conversion(k) &
[2232]1819                                                 * ddx * rmask(j,i,sr) * flag
[1353]1820                   sums_l(k,61,tn) = sums_l(k,61,tn) - 0.5_wp *                &
[1]1821                                                   ( kh(k,j,i) + kh(k,j-1,i) ) &
1822                                                 * ( pt(k,j-1,i) - pt(k,j,i) ) &
[2037]1823                                               * rho_air_zw(k)                 &
1824                                               * heatflux_output_conversion(k) &
[2232]1825                                                 * ddy * rmask(j,i,sr) * flag
[1]1826!
1827!--                Resolved horizontal heat fluxes u*pt*, v*pt*
1828                   sums_l(k,59,tn) = sums_l(k,59,tn) +                         &
1829                                                  ( u(k,j,i) - hom(k,1,1,sr) ) &
[1353]1830                                    * 0.5_wp * ( pt(k,j,i-1) - hom(k,1,4,sr) + &
[2037]1831                                                 pt(k,j,i)   - hom(k,1,4,sr) ) &
[2232]1832                                               * heatflux_output_conversion(k) &
1833                                               * flag
[1353]1834                   pts = 0.5_wp * ( pt(k,j-1,i) - hom(k,1,4,sr) +              &
1835                                    pt(k,j,i)   - hom(k,1,4,sr) )
[1]1836                   sums_l(k,62,tn) = sums_l(k,62,tn) +                         &
1837                                                  ( v(k,j,i) - hom(k,1,2,sr) ) &
[1353]1838                                    * 0.5_wp * ( pt(k,j-1,i) - hom(k,1,4,sr) + &
[2037]1839                                                 pt(k,j,i)   - hom(k,1,4,sr) ) &
[2232]1840                                               * heatflux_output_conversion(k) &
1841                                               * flag
[1]1842                ENDDO
1843             ENDDO
1844          ENDDO
1845!
1846!--       Fluxes at the surface must be zero (e.g. due to the Prandtl-layer)
[1353]1847          sums_l(nzb,58,tn) = 0.0_wp
1848          sums_l(nzb,59,tn) = 0.0_wp
1849          sums_l(nzb,60,tn) = 0.0_wp
1850          sums_l(nzb,61,tn) = 0.0_wp
1851          sums_l(nzb,62,tn) = 0.0_wp
1852          sums_l(nzb,63,tn) = 0.0_wp
[1]1853
1854       ENDIF
[2073]1855       !$OMP END PARALLEL
[87]1856
1857!
[1365]1858!--    Collect current large scale advection and subsidence tendencies for
1859!--    data output
[1691]1860       IF ( large_scale_forcing  .AND.  ( simulated_time > 0.0_wp ) )  THEN
[1365]1861!
1862!--       Interpolation in time of LSF_DATA
1863          nt = 1
[1386]1864          DO WHILE ( simulated_time - dt_3d > time_vert(nt) )
[1365]1865             nt = nt + 1
1866          ENDDO
[1386]1867          IF ( simulated_time - dt_3d /= time_vert(nt) )  THEN
[1365]1868            nt = nt - 1
1869          ENDIF
1870
[1386]1871          fac = ( simulated_time - dt_3d - time_vert(nt) )                     &
[1365]1872                / ( time_vert(nt+1)-time_vert(nt) )
1873
1874
1875          DO  k = nzb, nzt
[1382]1876             sums_ls_l(k,0) = td_lsa_lpt(k,nt)                                 &
1877                              + fac * ( td_lsa_lpt(k,nt+1) - td_lsa_lpt(k,nt) )
1878             sums_ls_l(k,1) = td_lsa_q(k,nt)                                   &
1879                              + fac * ( td_lsa_q(k,nt+1) - td_lsa_q(k,nt) )
[1365]1880          ENDDO
1881
[1382]1882          sums_ls_l(nzt+1,0) = sums_ls_l(nzt,0)
1883          sums_ls_l(nzt+1,1) = sums_ls_l(nzt,1)
1884
[1365]1885          IF ( large_scale_subsidence .AND. use_subsidence_tendencies )  THEN
1886
1887             DO  k = nzb, nzt
[1382]1888                sums_ls_l(k,2) = td_sub_lpt(k,nt) + fac *                      &
1889                                 ( td_sub_lpt(k,nt+1) - td_sub_lpt(k,nt) )
1890                sums_ls_l(k,3) = td_sub_q(k,nt) + fac *                        &
1891                                 ( td_sub_q(k,nt+1) - td_sub_q(k,nt) )
[1365]1892             ENDDO
1893
[1382]1894             sums_ls_l(nzt+1,2) = sums_ls_l(nzt,2)
1895             sums_ls_l(nzt+1,3) = sums_ls_l(nzt,3)
1896
[1365]1897          ENDIF
1898
1899       ENDIF
1900
[2232]1901       tn = 0
[2073]1902       !$OMP PARALLEL PRIVATE( i, j, k, tn )
[2232]1903       !$ tn = omp_get_thread_num()       
[1585]1904       IF ( radiation .AND. radiation_scheme == 'rrtmg' )  THEN
1905          !$OMP DO
1906          DO  i = nxl, nxr
1907             DO  j =  nys, nyn
[2232]1908                DO  k = nzb+1, nzt+1
1909                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
1910
[2270]1911                   sums_l(k,100,tn)  = sums_l(k,100,tn)  + rad_lw_in(k,j,i)    &
[2232]1912                                       * rmask(j,i,sr) * flag
[2270]1913                   sums_l(k,101,tn)  = sums_l(k,101,tn)  + rad_lw_out(k,j,i)   &
[2232]1914                                       * rmask(j,i,sr) * flag
[2270]1915                   sums_l(k,102,tn)  = sums_l(k,102,tn)  + rad_sw_in(k,j,i)    &
[2232]1916                                       * rmask(j,i,sr) * flag
[2270]1917                   sums_l(k,103,tn)  = sums_l(k,103,tn)  + rad_sw_out(k,j,i)   &
[2232]1918                                       * rmask(j,i,sr) * flag
[2270]1919                   sums_l(k,104,tn)  = sums_l(k,104,tn)  + rad_lw_cs_hr(k,j,i) &
[2232]1920                                       * rmask(j,i,sr) * flag
[2270]1921                   sums_l(k,105,tn)  = sums_l(k,105,tn)  + rad_lw_hr(k,j,i)    &
[2232]1922                                       * rmask(j,i,sr) * flag
[2270]1923                   sums_l(k,106,tn)  = sums_l(k,106,tn)  + rad_sw_cs_hr(k,j,i) &
[2232]1924                                       * rmask(j,i,sr) * flag
[2270]1925                   sums_l(k,107,tn)  = sums_l(k,107,tn)  + rad_sw_hr(k,j,i)    &
[2232]1926                                       * rmask(j,i,sr) * flag
[1585]1927                ENDDO
1928             ENDDO
1929          ENDDO
1930       ENDIF
[3637]1931
[1365]1932!
[3637]1933!--    Calculate the profiles for all other modules
1934       CALL module_interface_statistics( 'profiles', sr, tn, dots_max )
[3651]1935       !$OMP END PARALLEL
[1]1936
1937!
1938!--    Summation of thread sums
1939       IF ( threads_per_task > 1 )  THEN
1940          DO  i = 1, threads_per_task-1
1941             sums_l(:,3,0)          = sums_l(:,3,0) + sums_l(:,3,i)
1942             sums_l(:,4:40,0)       = sums_l(:,4:40,0) + sums_l(:,4:40,i)
[87]1943             sums_l(:,45:pr_palm,0) = sums_l(:,45:pr_palm,0) + &
1944                                      sums_l(:,45:pr_palm,i)
1945             IF ( max_pr_user > 0 )  THEN
1946                sums_l(:,pr_palm+1:pr_palm+max_pr_user,0) = &
1947                                   sums_l(:,pr_palm+1:pr_palm+max_pr_user,0) + &
1948                                   sums_l(:,pr_palm+1:pr_palm+max_pr_user,i)
1949             ENDIF
[3298]1950
1951             IF ( air_chemistry )  THEN
1952                IF ( max_pr_cs > 0 )  THEN                                 
1953                     sums_l(:,pr_palm+max_pr_user+1:pr_palm + max_pr_user+ max_pr_cs,0) =          &
1954                               sums_l(:,pr_palm+max_pr_user+1:pr_palm + max_pr_user+max_pr_cs,0) + &
1955                               sums_l(:,pr_palm+max_pr_user+1:pr_palm + max_pr_user+max_pr_cs,i)
1956
1957                ENDIF
1958             ENDIF
[4131]1959             IF ( salsa )  THEN
1960                IF ( max_pr_cs > 0 )  THEN
1961                   sums_l(:,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0) =    &
1962                      sums_l(:,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,0) + &
1963                      sums_l(:,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa,i)
1964
1965                ENDIF
1966             ENDIF
[1]1967          ENDDO
1968       ENDIF
1969
1970#if defined( __parallel )
[667]1971
[1]1972!
1973!--    Compute total sum from local sums
[622]1974       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[1365]1975       CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), ngp_sums, MPI_REAL,   &
[1]1976                           MPI_SUM, comm2d, ierr )
[1365]1977       IF ( large_scale_forcing )  THEN
1978          CALL MPI_ALLREDUCE( sums_ls_l(nzb,2), sums(nzb,83), ngp_sums_ls,     &
1979                              MPI_REAL, MPI_SUM, comm2d, ierr )
1980       ENDIF
[3298]1981
[3458]1982       IF ( air_chemistry  .AND.  max_pr_cs > 0 )  THEN
[3298]1983          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[3458]1984             DO  i = 1, max_pr_cs
1985                CALL MPI_ALLREDUCE( sums_l(nzb,pr_palm+max_pr_user+i,0),       &
1986                                    sums(nzb,pr_palm+max_pr_user+i),           &
1987                                    nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d, ierr )
1988             ENDDO
[3298]1989       ENDIF
1990
[4131]1991       IF ( salsa  .AND.  max_pr_salsa > 0 )  THEN
1992          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
1993             DO  i = 1, max_pr_salsa
1994                CALL MPI_ALLREDUCE( sums_l(nzb,pr_palm+max_pr_user+max_pr_cs+i,0),                 &
1995                                    sums(nzb,pr_palm+max_pr_user+max_pr_user+i),                   &
1996                                    nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d, ierr )
1997             ENDDO
1998       ENDIF
1999
[1]2000#else
2001       sums = sums_l(:,:,0)
[1365]2002       IF ( large_scale_forcing )  THEN
2003          sums(:,81:88) = sums_ls_l
2004       ENDIF
[1]2005#endif
2006
2007!
2008!--    Final values are obtained by division by the total number of grid points
2009!--    used for summation. After that store profiles.
[1738]2010!--    Check, if statistical regions do contain at least one grid point at the
2011!--    respective k-level, otherwise division by zero will lead to undefined
2012!--    values, which may cause e.g. problems with NetCDF output
[1]2013!--    Profiles:
2014       DO  k = nzb, nzt+1
[1738]2015          sums(k,3)             = sums(k,3)             / ngp_2dh(sr)
2016          sums(k,12:22)         = sums(k,12:22)         / ngp_2dh(sr)
2017          sums(k,30:32)         = sums(k,30:32)         / ngp_2dh(sr)
2018          sums(k,35:39)         = sums(k,35:39)         / ngp_2dh(sr)
2019          sums(k,45:53)         = sums(k,45:53)         / ngp_2dh(sr)
2020          sums(k,55:63)         = sums(k,55:63)         / ngp_2dh(sr)
2021          sums(k,81:88)         = sums(k,81:88)         / ngp_2dh(sr)
[2270]2022          sums(k,89:112)        = sums(k,89:112)        / ngp_2dh(sr)
2023          sums(k,114)           = sums(k,114)           / ngp_2dh(sr)
2024          sums(k,117)           = sums(k,117)           / ngp_2dh(sr)
[1738]2025          IF ( ngp_2dh_s_inner(k,sr) /= 0 )  THEN
2026             sums(k,8:11)          = sums(k,8:11)          / ngp_2dh_s_inner(k,sr)
2027             sums(k,23:29)         = sums(k,23:29)         / ngp_2dh_s_inner(k,sr)
2028             sums(k,33:34)         = sums(k,33:34)         / ngp_2dh_s_inner(k,sr)
2029             sums(k,40)            = sums(k,40)            / ngp_2dh_s_inner(k,sr)
2030             sums(k,54)            = sums(k,54)            / ngp_2dh_s_inner(k,sr)
2031             sums(k,64)            = sums(k,64)            / ngp_2dh_s_inner(k,sr)
2032             sums(k,70:80)         = sums(k,70:80)         / ngp_2dh_s_inner(k,sr)
[2270]2033             sums(k,116)           = sums(k,116)           / ngp_2dh_s_inner(k,sr)
2034             sums(k,118:pr_palm-2) = sums(k,118:pr_palm-2) / ngp_2dh_s_inner(k,sr)
[3452]2035             sums(k,123)           = sums(k,123) * ngp_2dh_s_inner(k,sr)  / ngp_2dh(sr)
[1738]2036          ENDIF
[1]2037       ENDDO
[667]2038
[1]2039!--    u* and so on
[87]2040!--    As sums(nzb:nzb+3,pr_palm) are full 2D arrays (us, usws, vsws, ts) whose
[1]2041!--    size is always ( nx + 1 ) * ( ny + 1 ), defined at the first grid layer
2042!--    above the topography, they are being divided by ngp_2dh(sr)
[87]2043       sums(nzb:nzb+3,pr_palm)    = sums(nzb:nzb+3,pr_palm)    / &
[1]2044                                    ngp_2dh(sr)
[197]2045       sums(nzb+12,pr_palm)       = sums(nzb+12,pr_palm)       / &    ! qs
2046                                    ngp_2dh(sr)
[1960]2047       sums(nzb+13,pr_palm)       = sums(nzb+13,pr_palm)       / &    ! ss
2048                                    ngp_2dh(sr)
[2773]2049       sums(nzb+14,pr_palm)       = sums(nzb+14,pr_palm)       / &    ! surface temperature
2050                                    ngp_2dh(sr)
[1]2051!--    eges, e*
[87]2052       sums(nzb+4:nzb+5,pr_palm)  = sums(nzb+4:nzb+5,pr_palm)  / &
[132]2053                                    ngp_3d(sr)
[1]2054!--    Old and new divergence
[87]2055       sums(nzb+9:nzb+10,pr_palm) = sums(nzb+9:nzb+10,pr_palm) / &
[1]2056                                    ngp_3d_inner(sr)
2057
[87]2058!--    User-defined profiles
2059       IF ( max_pr_user > 0 )  THEN
2060          DO  k = nzb, nzt+1
2061             sums(k,pr_palm+1:pr_palm+max_pr_user) = &
2062                                    sums(k,pr_palm+1:pr_palm+max_pr_user) / &
[132]2063                                    ngp_2dh_s_inner(k,sr)
[87]2064          ENDDO
2065       ENDIF
[1007]2066
[3298]2067       IF ( air_chemistry ) THEN
2068          IF ( max_pr_cs > 0 )  THEN                 
2069             DO k = nzb, nzt+1
2070                sums(k, pr_palm+1:pr_palm+max_pr_user+max_pr_cs) = &
2071                                 sums(k, pr_palm+1:pr_palm+max_pr_user+max_pr_cs) / &
2072                                 ngp_2dh_s_inner(k,sr)
2073             ENDDO
2074          ENDIF 
2075       ENDIF
2076
[4131]2077       IF ( salsa ) THEN
2078          IF ( max_pr_salsa > 0 )  THEN
2079             DO k = nzb, nzt+1
2080                sums(k,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa) = &
2081                  sums(k,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa) &
2082                  / ngp_2dh_s_inner(k,sr)
2083             ENDDO
2084          ENDIF 
2085       ENDIF
2086
[1]2087!
2088!--    Collect horizontal average in hom.
2089!--    Compute deduced averages (e.g. total heat flux)
2090       hom(:,1,3,sr)  = sums(:,3)      ! w
2091       hom(:,1,8,sr)  = sums(:,8)      ! e     profiles 5-7 are initial profiles
2092       hom(:,1,9,sr)  = sums(:,9)      ! km
2093       hom(:,1,10,sr) = sums(:,10)     ! kh
2094       hom(:,1,11,sr) = sums(:,11)     ! l
2095       hom(:,1,12,sr) = sums(:,12)     ! w"u"
2096       hom(:,1,13,sr) = sums(:,13)     ! w*u*
2097       hom(:,1,14,sr) = sums(:,14)     ! w"v"
2098       hom(:,1,15,sr) = sums(:,15)     ! w*v*
2099       hom(:,1,16,sr) = sums(:,16)     ! w"pt"
2100       hom(:,1,17,sr) = sums(:,17)     ! w*pt*
2101       hom(:,1,18,sr) = sums(:,16) + sums(:,17)    ! wpt
2102       hom(:,1,19,sr) = sums(:,12) + sums(:,13)    ! wu
2103       hom(:,1,20,sr) = sums(:,14) + sums(:,15)    ! wv
2104       hom(:,1,21,sr) = sums(:,21)     ! w*pt*BC
2105       hom(:,1,22,sr) = sums(:,16) + sums(:,21)    ! wptBC
[96]2106                                       ! profile 24 is initial profile (sa)
2107                                       ! profiles 25-29 left empty for initial
[1]2108                                       ! profiles
2109       hom(:,1,30,sr) = sums(:,30)     ! u*2
2110       hom(:,1,31,sr) = sums(:,31)     ! v*2
2111       hom(:,1,32,sr) = sums(:,32)     ! w*2
2112       hom(:,1,33,sr) = sums(:,33)     ! pt*2
2113       hom(:,1,34,sr) = sums(:,34)     ! e*
2114       hom(:,1,35,sr) = sums(:,35)     ! w*2pt*
2115       hom(:,1,36,sr) = sums(:,36)     ! w*pt*2
2116       hom(:,1,37,sr) = sums(:,37)     ! w*e*
2117       hom(:,1,38,sr) = sums(:,38)     ! w*3
[1353]2118       hom(:,1,39,sr) = sums(:,38) / ( abs( sums(:,32) ) + 1E-20_wp )**1.5_wp   ! Sw
[1]2119       hom(:,1,40,sr) = sums(:,40)     ! p
[531]2120       hom(:,1,45,sr) = sums(:,45)     ! w"vpt"
[1]2121       hom(:,1,46,sr) = sums(:,46)     ! w*vpt*       
2122       hom(:,1,47,sr) = sums(:,45) + sums(:,46)    ! wvpt
2123       hom(:,1,48,sr) = sums(:,48)     ! w"q" (w"qv")
2124       hom(:,1,49,sr) = sums(:,49)     ! w*q* (w*qv*)
2125       hom(:,1,50,sr) = sums(:,48) + sums(:,49)    ! wq (wqv)
2126       hom(:,1,51,sr) = sums(:,51)     ! w"qv"
2127       hom(:,1,52,sr) = sums(:,52)     ! w*qv*       
2128       hom(:,1,53,sr) = sums(:,52) + sums(:,51)    ! wq (wqv)
2129       hom(:,1,54,sr) = sums(:,54)     ! ql
2130       hom(:,1,55,sr) = sums(:,55)     ! w*u*u*/dz
2131       hom(:,1,56,sr) = sums(:,56)     ! w*p*/dz
[2031]2132       hom(:,1,57,sr) = sums(:,57)     ! ( w"e + w"p"/rho_ocean )/dz
[1]2133       hom(:,1,58,sr) = sums(:,58)     ! u"pt"
2134       hom(:,1,59,sr) = sums(:,59)     ! u*pt*
2135       hom(:,1,60,sr) = sums(:,58) + sums(:,59)    ! upt_t
2136       hom(:,1,61,sr) = sums(:,61)     ! v"pt"
2137       hom(:,1,62,sr) = sums(:,62)     ! v*pt*
2138       hom(:,1,63,sr) = sums(:,61) + sums(:,62)    ! vpt_t
[2031]2139       hom(:,1,64,sr) = sums(:,64)     ! rho_ocean
[96]2140       hom(:,1,65,sr) = sums(:,65)     ! w"sa"
2141       hom(:,1,66,sr) = sums(:,66)     ! w*sa*
2142       hom(:,1,67,sr) = sums(:,65) + sums(:,66)    ! wsa
[106]2143       hom(:,1,68,sr) = sums(:,68)     ! w*p*
[2031]2144       hom(:,1,69,sr) = sums(:,69)     ! w"e + w"p"/rho_ocean
[197]2145       hom(:,1,70,sr) = sums(:,70)     ! q*2
[388]2146       hom(:,1,71,sr) = sums(:,71)     ! prho
[2252]2147       hom(:,1,72,sr) = hyp * 1E-2_wp  ! hyp in hPa
[2292]2148       hom(:,1,123,sr) = sums(:,123)   ! nc
[1053]2149       hom(:,1,73,sr) = sums(:,73)     ! nr
2150       hom(:,1,74,sr) = sums(:,74)     ! qr
2151       hom(:,1,75,sr) = sums(:,75)     ! qc
2152       hom(:,1,76,sr) = sums(:,76)     ! prr (precipitation rate)
[1179]2153                                       ! 77 is initial density profile
[1241]2154       hom(:,1,78,sr) = ug             ! ug
2155       hom(:,1,79,sr) = vg             ! vg
[1299]2156       hom(:,1,80,sr) = w_subs         ! w_subs
[1]2157
[1365]2158       IF ( large_scale_forcing )  THEN
[1382]2159          hom(:,1,81,sr) = sums_ls_l(:,0)          ! td_lsa_lpt
2160          hom(:,1,82,sr) = sums_ls_l(:,1)          ! td_lsa_q
[1365]2161          IF ( use_subsidence_tendencies )  THEN
[1382]2162             hom(:,1,83,sr) = sums_ls_l(:,2)       ! td_sub_lpt
2163             hom(:,1,84,sr) = sums_ls_l(:,3)       ! td_sub_q
[1365]2164          ELSE
[1382]2165             hom(:,1,83,sr) = sums(:,83)           ! td_sub_lpt
2166             hom(:,1,84,sr) = sums(:,84)           ! td_sub_q
[1365]2167          ENDIF
[1382]2168          hom(:,1,85,sr) = sums(:,85)              ! td_nud_lpt
2169          hom(:,1,86,sr) = sums(:,86)              ! td_nud_q
2170          hom(:,1,87,sr) = sums(:,87)              ! td_nud_u
2171          hom(:,1,88,sr) = sums(:,88)              ! td_nud_v
[1365]2172       ENDIF
2173
[1551]2174       IF ( land_surface )  THEN
2175          hom(:,1,89,sr) = sums(:,89)              ! t_soil
2176                                                   ! 90 is initial t_soil profile
2177          hom(:,1,91,sr) = sums(:,91)              ! m_soil
2178                                                   ! 92 is initial m_soil profile
[2270]2179          hom(:,1,93,sr)  = sums(:,93)             ! ghf
2180          hom(:,1,94,sr)  = sums(:,94)             ! qsws_liq
2181          hom(:,1,95,sr)  = sums(:,95)             ! qsws_soil
2182          hom(:,1,96,sr)  = sums(:,96)             ! qsws_veg
2183          hom(:,1,97,sr)  = sums(:,97)             ! r_a
2184          hom(:,1,98,sr) = sums(:,98)              ! r_s
[1555]2185
[1551]2186       ENDIF
2187
2188       IF ( radiation )  THEN
[2270]2189          hom(:,1,99,sr) = sums(:,99)            ! rad_net
2190          hom(:,1,100,sr) = sums(:,100)            ! rad_lw_in
2191          hom(:,1,101,sr) = sums(:,101)            ! rad_lw_out
2192          hom(:,1,102,sr) = sums(:,102)            ! rad_sw_in
2193          hom(:,1,103,sr) = sums(:,103)            ! rad_sw_out
[1585]2194
[1691]2195          IF ( radiation_scheme == 'rrtmg' )  THEN
[2270]2196             hom(:,1,104,sr) = sums(:,104)            ! rad_lw_cs_hr
2197             hom(:,1,105,sr) = sums(:,105)            ! rad_lw_hr
2198             hom(:,1,106,sr) = sums(:,106)            ! rad_sw_cs_hr
2199             hom(:,1,107,sr) = sums(:,107)            ! rad_sw_hr
[1691]2200
[2270]2201             hom(:,1,108,sr) = sums(:,108)            ! rrtm_aldif
2202             hom(:,1,109,sr) = sums(:,109)            ! rrtm_aldir
2203             hom(:,1,110,sr) = sums(:,110)            ! rrtm_asdif
2204             hom(:,1,111,sr) = sums(:,111)            ! rrtm_asdir
[1585]2205          ENDIF
[1551]2206       ENDIF
2207
[2270]2208       hom(:,1,112,sr) = sums(:,112)            !: L
[1691]2209
[1960]2210       IF ( passive_scalar )  THEN
[2270]2211          hom(:,1,117,sr) = sums(:,117)     ! w"s"
2212          hom(:,1,114,sr) = sums(:,114)     ! w*s*
2213          hom(:,1,118,sr) = sums(:,117) + sums(:,114)    ! ws
2214          hom(:,1,116,sr) = sums(:,116)     ! s*2
[1960]2215       ENDIF
2216
[2270]2217       hom(:,1,119,sr) = rho_air       ! rho_air in Kg/m^3
2218       hom(:,1,120,sr) = rho_air_zw    ! rho_air_zw in Kg/m^3
[2037]2219
[667]2220       hom(:,1,pr_palm,sr) =   sums(:,pr_palm)
[1]2221                                       ! u*, w'u', w'v', t* (in last profile)
2222
[87]2223       IF ( max_pr_user > 0 )  THEN    ! user-defined profiles
2224          hom(:,1,pr_palm+1:pr_palm+max_pr_user,sr) = &
2225                               sums(:,pr_palm+1:pr_palm+max_pr_user)
2226       ENDIF
2227
[3298]2228       IF ( air_chemistry )  THEN
2229          IF ( max_pr_cs > 0 )  THEN    ! chem_spcs profiles     
2230             hom(:, 1, pr_palm+max_pr_user+1:pr_palm + max_pr_user+max_pr_cs, sr) = &
2231                               sums(:, pr_palm+max_pr_user+1:pr_palm+max_pr_user+max_pr_cs)
2232          ENDIF
2233       ENDIF
[4131]2234
2235       IF ( salsa )  THEN
2236          IF ( max_pr_salsa > 0 )  THEN    ! salsa profiles
2237             hom(:,1,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa, sr) = &
2238                  sums(:,pr_palm+max_pr_user+max_pr_cs+1:pr_palm+max_pr_user+max_pr_cs+max_pr_salsa)
2239          ENDIF
2240       ENDIF
[1]2241!
2242!--    Determine the boundary layer height using two different schemes.
[94]2243!--    First scheme: Starting from the Earth's (Ocean's) surface, look for the
2244!--    first relative minimum (maximum) of the total heat flux.
2245!--    The corresponding height is assumed as the boundary layer height, if it
2246!--    is less than 1.5 times the height where the heat flux becomes negative
[3004]2247!--    (positive) for the first time. Attention: the resolved vertical sensible
2248!--    heat flux (hom(:,1,17,sr) = w*pt*) is not known at the beginning because
2249!--    the calculation happens in advec_s_ws which is called after
2250!--    flow_statistics. Therefore z_i is directly taken from restart data at
2251!--    the beginning of restart runs. 
[3003]2252       IF ( TRIM( initializing_actions ) /= 'read_restart_data' .OR.           &
2253            simulated_time_at_begin /= simulated_time ) THEN
[667]2254
[3003]2255          z_i(1) = 0.0_wp
2256          first = .TRUE.
2257
[3294]2258          IF ( ocean_mode )  THEN
[3003]2259             DO  k = nzt, nzb+1, -1
2260                IF ( first  .AND.  hom(k,1,18,sr) < -1.0E-8_wp )  THEN
2261                   first = .FALSE.
2262                   height = zw(k)
[97]2263                ENDIF
[3003]2264                IF ( hom(k,1,18,sr) < -1.0E-8_wp  .AND.                        &
2265                     hom(k-1,1,18,sr) > hom(k,1,18,sr) )  THEN
2266                   IF ( zw(k) < 1.5_wp * height )  THEN
2267                      z_i(1) = zw(k)
2268                   ELSE
2269                      z_i(1) = height
2270                   ENDIF
2271                   EXIT
[94]2272                ENDIF
[3003]2273             ENDDO
2274          ELSE
2275             DO  k = nzb, nzt-1
2276                IF ( first  .AND.  hom(k,1,18,sr) < -1.0E-8_wp )  THEN
2277                   first = .FALSE.
2278                   height = zw(k)
2279                ENDIF
2280                IF ( hom(k,1,18,sr) < -1.0E-8_wp  .AND.                        &
2281                     hom(k+1,1,18,sr) > hom(k,1,18,sr) )  THEN
2282                   IF ( zw(k) < 1.5_wp * height )  THEN
2283                      z_i(1) = zw(k)
2284                   ELSE
2285                      z_i(1) = height
2286                   ENDIF
2287                   EXIT
2288                ENDIF
2289             ENDDO
2290          ENDIF
[1]2291
2292!
[3003]2293!--       Second scheme: Gradient scheme from Sullivan et al. (1998), modified
2294!--       by Uhlenbrock(2006). The boundary layer height is the height with the
2295!--       maximal local temperature gradient: starting from the second (the
2296!--       last but one) vertical gridpoint, the local gradient must be at least
2297!--       0.2K/100m and greater than the next four gradients.
2298!--       WARNING: The threshold value of 0.2K/100m must be adjusted for the
2299!--       ocean case!
2300          z_i(2) = 0.0_wp
2301          DO  k = nzb+1, nzt+1
2302             dptdz(k) = ( hom(k,1,4,sr) - hom(k-1,1,4,sr) ) * ddzu(k)
2303          ENDDO
2304          dptdz_threshold = 0.2_wp / 100.0_wp
[291]2305
[3294]2306          IF ( ocean_mode )  THEN
[3003]2307             DO  k = nzt+1, nzb+5, -1
2308                IF ( dptdz(k) > dptdz_threshold  .AND.                         &
2309                     dptdz(k) > dptdz(k-1)  .AND.  dptdz(k) > dptdz(k-2)  .AND.&
2310                     dptdz(k) > dptdz(k-3)  .AND.  dptdz(k) > dptdz(k-4) )  THEN
2311                   z_i(2) = zw(k-1)
2312                   EXIT
2313                ENDIF
2314             ENDDO
2315          ELSE
2316             DO  k = nzb+1, nzt-3
2317                IF ( dptdz(k) > dptdz_threshold  .AND.                         &
2318                     dptdz(k) > dptdz(k+1)  .AND.  dptdz(k) > dptdz(k+2)  .AND.&
2319                     dptdz(k) > dptdz(k+3)  .AND.  dptdz(k) > dptdz(k+4) )  THEN
2320                   z_i(2) = zw(k-1)
2321                   EXIT
2322                ENDIF
2323             ENDDO
2324          ENDIF
2325
[97]2326       ENDIF
[1]2327
[87]2328       hom(nzb+6,1,pr_palm,sr) = z_i(1)
2329       hom(nzb+7,1,pr_palm,sr) = z_i(2)
[1]2330
2331!
[1738]2332!--    Determine vertical index which is nearest to the mean surface level
2333!--    height of the respective statistic region
2334       DO  k = nzb, nzt
2335          IF ( zw(k) >= mean_surface_level_height(sr) )  THEN
2336             k_surface_level = k
2337             EXIT
2338          ENDIF
2339       ENDDO
[3003]2340
[1738]2341!
[1]2342!--    Computation of both the characteristic vertical velocity and
2343!--    the characteristic convective boundary layer temperature.
[1738]2344!--    The inversion height entering into the equation is defined with respect
2345!--    to the mean surface level height of the respective statistic region.
2346!--    The horizontal average at surface level index + 1 is input for the
2347!--    average temperature.
2348       IF ( hom(k_surface_level,1,18,sr) > 1.0E-8_wp  .AND.  z_i(1) /= 0.0_wp )&
2349       THEN
[2252]2350          hom(nzb+8,1,pr_palm,sr) =                                            &
[2037]2351             ( g / hom(k_surface_level+1,1,4,sr) *                             &
[2252]2352             ( hom(k_surface_level,1,18,sr) /                                  &
2353             ( heatflux_output_conversion(nzb) * rho_air(nzb) ) )              &
[1738]2354             * ABS( z_i(1) - mean_surface_level_height(sr) ) )**0.333333333_wp
[1]2355       ELSE
[1353]2356          hom(nzb+8,1,pr_palm,sr)  = 0.0_wp
[1]2357       ENDIF
2358
[48]2359!
[2968]2360!--    Collect the time series quantities. Please note, timeseries quantities
2361!--    which are collected from horizontally averaged profiles, e.g. wpt
2362!--    or pt(zp), are treated specially. In case of elevated model surfaces,
2363!--    index nzb+1 might be within topography and data will be zero. Therefore,
2364!--    take value for the first atmosphere index, which is topo_min_level+1.
2365       ts_value(1,sr) = hom(nzb+4,1,pr_palm,sr)        ! E
2366       ts_value(2,sr) = hom(nzb+5,1,pr_palm,sr)        ! E*
[48]2367       ts_value(3,sr) = dt_3d
[2968]2368       ts_value(4,sr) = hom(nzb,1,pr_palm,sr)          ! u*
2369       ts_value(5,sr) = hom(nzb+3,1,pr_palm,sr)        ! th*
[48]2370       ts_value(6,sr) = u_max
2371       ts_value(7,sr) = v_max
2372       ts_value(8,sr) = w_max
[2968]2373       ts_value(9,sr) = hom(nzb+10,1,pr_palm,sr)       ! new divergence
2374       ts_value(10,sr) = hom(nzb+9,1,pr_palm,sr)       ! old Divergence
2375       ts_value(11,sr) = hom(nzb+6,1,pr_palm,sr)       ! z_i(1)
2376       ts_value(12,sr) = hom(nzb+7,1,pr_palm,sr)       ! z_i(2)
2377       ts_value(13,sr) = hom(nzb+8,1,pr_palm,sr)       ! w*
2378       ts_value(14,sr) = hom(nzb,1,16,sr)              ! w'pt'   at k=0
2379       ts_value(15,sr) = hom(topo_min_level+1,1,16,sr) ! w'pt'   at k=1
2380       ts_value(16,sr) = hom(topo_min_level+1,1,18,sr) ! wpt     at k=1
2381       ts_value(17,sr) = hom(nzb+14,1,pr_palm,sr)      ! pt(0)
2382       ts_value(18,sr) = hom(topo_min_level+1,1,4,sr)  ! pt(zp)
2383       ts_value(19,sr) = hom(nzb+1,1,pr_palm,sr)       ! u'w'    at k=0
2384       ts_value(20,sr) = hom(nzb+2,1,pr_palm,sr)       ! v'w'    at k=0
2385       ts_value(21,sr) = hom(nzb,1,48,sr)              ! w"q"    at k=0
[1709]2386
2387       IF ( .NOT. neutral )  THEN
[2270]2388          ts_value(22,sr) = hom(nzb,1,112,sr)          ! L
[48]2389       ELSE
[1709]2390          ts_value(22,sr) = 1.0E10_wp
[48]2391       ENDIF
[1]2392
[343]2393       ts_value(23,sr) = hom(nzb+12,1,pr_palm,sr)   ! q*
[1551]2394
[1960]2395       IF ( passive_scalar )  THEN
[2270]2396          ts_value(24,sr) = hom(nzb+13,1,117,sr)       ! w"s" ( to do ! )
[1960]2397          ts_value(25,sr) = hom(nzb+13,1,pr_palm,sr)   ! s*
2398       ENDIF
2399
[1]2400!
[1551]2401!--    Collect land surface model timeseries
2402       IF ( land_surface )  THEN
[2270]2403          ts_value(dots_soil  ,sr) = hom(nzb,1,93,sr)           ! ghf
2404          ts_value(dots_soil+1,sr) = hom(nzb,1,94,sr)           ! qsws_liq
2405          ts_value(dots_soil+2,sr) = hom(nzb,1,95,sr)           ! qsws_soil
2406          ts_value(dots_soil+3,sr) = hom(nzb,1,96,sr)           ! qsws_veg
2407          ts_value(dots_soil+4,sr) = hom(nzb,1,97,sr)           ! r_a
2408          ts_value(dots_soil+5,sr) = hom(nzb,1,98,sr)           ! r_s
[1551]2409       ENDIF
2410!
2411!--    Collect radiation model timeseries
2412       IF ( radiation )  THEN
[2270]2413          ts_value(dots_rad,sr)   = hom(nzb,1,99,sr)           ! rad_net
2414          ts_value(dots_rad+1,sr) = hom(nzb,1,100,sr)          ! rad_lw_in
2415          ts_value(dots_rad+2,sr) = hom(nzb,1,101,sr)          ! rad_lw_out
2416          ts_value(dots_rad+3,sr) = hom(nzb,1,102,sr)          ! rad_sw_in
2417          ts_value(dots_rad+4,sr) = hom(nzb,1,103,sr)          ! rad_sw_out
[1585]2418
2419          IF ( radiation_scheme == 'rrtmg' )  THEN
[2270]2420             ts_value(dots_rad+5,sr) = hom(nzb,1,108,sr)          ! rrtm_aldif
2421             ts_value(dots_rad+6,sr) = hom(nzb,1,109,sr)          ! rrtm_aldir
2422             ts_value(dots_rad+7,sr) = hom(nzb,1,110,sr)          ! rrtm_asdif
2423             ts_value(dots_rad+8,sr) = hom(nzb,1,111,sr)          ! rrtm_asdir
[1585]2424          ENDIF
2425
[1551]2426       ENDIF
2427
2428!
[3637]2429!--    Calculate additional statistics provided by other modules
2430       CALL module_interface_statistics( 'time_series', sr, 0, dots_max )
[2817]2431
[48]2432    ENDDO    ! loop of the subregions
2433
[1]2434!
[1918]2435!-- If required, sum up horizontal averages for subsequent time averaging.
2436!-- Do not sum, if flow statistics is called before the first initial time step.
2437    IF ( do_sum  .AND.  simulated_time /= 0.0_wp )  THEN
[1353]2438       IF ( average_count_pr == 0 )  hom_sum = 0.0_wp
[1]2439       hom_sum = hom_sum + hom(:,1,:,:)
2440       average_count_pr = average_count_pr + 1
2441       do_sum = .FALSE.
2442    ENDIF
2443
2444!
2445!-- Set flag for other UPs (e.g. output routines, but also buoyancy).
2446!-- This flag is reset after each time step in time_integration.
2447    flow_statistics_called = .TRUE.
2448
2449    CALL cpu_log( log_point(10), 'flow_statistics', 'stop' )
2450
2451
2452 END SUBROUTINE flow_statistics
Note: See TracBrowser for help on using the repository browser.