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

Last change on this file since 3861 was 3828, checked in by raasch, 6 years ago

further gfortran warnings activated on testserver, unused variables removed

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