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

Last change on this file since 3665 was 3658, checked in by knoop, 6 years ago

OpenACC: flow_statistics partly ported to GPU

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