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

Last change on this file since 2287 was 2270, checked in by maronga, 7 years ago

major revisions in land surface model

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