Changeset 4466 for palm/trunk


Ignore:
Timestamp:
Mar 20, 2020 4:14:41 PM (4 years ago)
Author:
suehring
Message:

Vector branch in advec_ws optimized, symmetric boundary conditions implemented in vector branch

Location:
palm/trunk/SOURCE
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/Makefile

    r4458 r4466  
    2525# -----------------
    2626# $Id$
     27# cpu measures in advec_ws added
     28#
     29# 4458 2020-03-11 15:37:31Z raasch
    2730# bugfix for r4457: missing dependency added
    28 # 
     31#
    2932# 4457 2020-03-11 14:20:43Z raasch
    3033# exchange horiz has been modularized and exchange horiz 2d has been merged, dependencies updated
    3134# accordingly
    32 # 
     35#
    3336# 4453 2020-03-11 08:10:13Z raasch
    3437# dependencies for exchange horiz modified
    35 # 
     38#
    3639# 4434 2020-03-03 10:02:18Z oliver.maas
    3740# Added output control for wind turbine model
    38 # 
     41#
    3942# 4414 2020-02-19 20:16:04Z suehring
    4043# Move dependencies for init grid from advection scheme and multigrid solver
    4144# to module_interface
    42 # 
     45#
    4346# 4411 2020-02-18 14:28:02Z maronga
    4447# Added output routines for WTM
    45 # 
     48#
    4649# 4400 2020-02-10 20:32:41Z suehring
    4750# Add dependency for data-output module
    48 # 
     51#
    4952# 4392 2020-01-31 16:14:57Z pavelkrc
    5053# add dependency on fft for transpose
    51 # 
     54#
    5255# 4347 2019-12-18 13:18:33Z suehring
    5356# add dependency to basic_constants_and_equations_mod for dynamics_mod
    54 # 
     57#
    5558# 4331 2019-12-10 18:25:02Z suehring
    5659# Move diagnostic surface output to diagnostic_output_quantities
    57 # 
     60#
    5861# 4309 2019-11-26 18:49:59Z suehring
    5962# Add dependency to parallel random generator for synthetic turbulence generator
    60 # 
     63#
    6164# 4286 2019-10-30 16:01:14Z resler
    6265# delete boundary_conds, added missing dependencies
    63 # 
     66#
    6467# 4270 2019-10-23 10:46:20Z monakurppa
    6568# - Implement offline nesting for salsa and add dependency of nesting_offl_mod
     
    6871#   for salsa
    6972# - Add dependency on basic_constants_and_equations_mod for salsa_mod
    70 # 
     73#
    7174# 4258 2019-10-07 13:29:08Z suehring
    7275# Add dependency of land-surface model on pmc_handle_communicator and cpu_log
    73 # 
     76#
    7477# 4245 2019-09-30 08:40:37Z pavelkrc
    7578# Remove no longer needed dependencies on surface_mod
    76 # 
     79#
    7780# 4227 2019-09-10 18:04:34Z gronemeier
    7881# Add palm_date_time_mod, remove date_and_time_mod
     
    8083# 4223 2019-09-10 09:20:47Z gronemeier
    8184# Corrected "Former revisions" section
    82 # 
     85#
    8386# 4174 2019-08-20 12:41:13Z gronemeier
    8487# bugfix: add missing dependencies for vdi_internal_controls
    85 # 
     88#
    8689# 4173 2019-08-20 12:04:06Z gronemeier
    8790# add vdi_internal_controls
    88 # 
     91#
    8992# 4168 2019-08-16 13:50:17Z suehring
    9093# Remove some dependencies on surface_mod that are no longer required without
    9194# get_topography_top_index functions
    92 # 
     95#
    9396# 4167 2019-08-16 11:01:48Z suehring
    9497# Remove no longer needed dependencies on surface_mod
    95 # 
     98#
    9699# 4127 2019-07-30 14:47:10Z suehring
    97 # Add dependency of data_output_3d on plant_canopy_model_mod 
     100# Add dependency of data_output_3d on plant_canopy_model_mod
    98101# (merge from branch resler)
    99102#
    100103# 4106 2019-07-19 08:54:42Z gronemeier
    101104# Remove dependency on pmc_interface for boundary_conds
    102 # 
     105#
    103106# 4070 2019-07-03 13:51:40Z gronemeier
    104107# Add new data output modules
     
    358361        modules.o
    359362advec_ws.o: \
     363        cpulog_mod.o \
    360364        exchange_horiz_mod.o \
    361365        mod_kinds.o \
     
    825829        modules.o \
    826830        netcdf_data_input_mod.o \
    827         salsa_mod.o 
     831        salsa_mod.o
    828832netcdf_data_input_mod.o: \
    829833        chem_modules.o \
  • palm/trunk/SOURCE/advec_ws.f90

    r4457 r4466  
    2020! Current revisions:
    2121! ------------------
    22 ! 
    23 ! 
     22!
     23!
    2424! Former revisions:
    2525! -----------------
    2626! $Id$
     27! - vector branch further optimized (linear dependencies along z removed and
     28!   loops are splitted)
     29! - topography closed channel flow with symmetric boundaries also implemented
     30!   in vector branch
     31! - some formatting adjustments made and comments added
     32! - cpu measures for vector branch added
     33!
     34! 4457 2020-03-11 14:20:43Z raasch
    2735! use statement for exchange horiz added
    28 ! 
     36!
    2937! 4414 2020-02-19 20:16:04Z suehring
    3038! Move call for initialization of control flags to ws_init
    31 ! 
     39!
    3240! 4360 2020-01-07 11:25:50Z suehring
    3341! Introduction of wall_flags_total_0, which currently sets bits based on static
    3442! topography information used in wall_flags_static_0
    35 ! 
     43!
    3644! 4340 2019-12-16 08:17:03Z Giersch
    37 ! Topography closed channel flow with symmetric boundaries implemented 
    38 ! 
     45! Topography closed channel flow with symmetric boundaries implemented
     46!
    3947! 4330 2019-12-10 16:16:33Z knoop
    4048! Bugix: removed syntax error introduced by last commit
    41 ! 
     49!
    4250! 4329 2019-12-10 15:46:36Z motisi
    4351! Renamed wall_flags_0 to wall_flags_static_0
    44 ! 
     52!
    4553! 4328 2019-12-09 18:53:04Z suehring
    4654! Minor formatting adjustments
    47 ! 
     55!
    4856! 4327 2019-12-06 14:48:31Z Giersch
    4957! Setting of advection flags for vertical fluxes of w revised, air density for
    5058! vertical flux calculation of w at k=1 is considered now
    51 ! 
     59!
    5260! 4325 2019-12-06 07:14:04Z Giersch
    53 ! Vertical fluxes of w are now set to zero at nzt and nzt+1, setting of 
     61! Vertical fluxes of w are now set to zero at nzt and nzt+1, setting of
    5462! advection flags for fluxes in z-direction revised, comments extended
    55 ! 
     63!
    5664! 4324 2019-12-06 07:11:33Z Giersch
    5765! Indirect indexing for calculating vertical fluxes close to boundaries is only
    5866! used for loop indizes where it is really necessary
    59 ! 
     67!
    6068! 4317 2019-12-03 12:43:22Z Giersch
    61 ! Comments revised/added, formatting improved, fluxes for u,v, and scalars are 
     69! Comments revised/added, formatting improved, fluxes for u,v, and scalars are
    6270! explicitly set to zero at nzt+1, fluxes of w-component are now calculated only
    6371! until nzt-1 (Prognostic equation for w-velocity component ends at nzt-1)
    64 ! 
     72!
    6573! 4204 2019-08-30 12:30:17Z knoop
    6674! Bugfix: Changed sk_num initialization default to avoid implicit SAVE-Attribut
    67 ! 
     75!
    6876! 4182 2019-08-22 15:20:23Z scharf
    6977! Corrected "Former revisions" section
    70 ! 
     78!
    7179! 4110 2019-07-22 17:05:21Z suehring
    7280! - Separate initialization of advection flags for momentum and scalars. In this
    73 !   context, resort the bits and do some minor formatting. 
    74 ! - Make flag initialization for scalars more flexible, introduce an 
    75 !   arguemnt list to indicate non-cyclic boundaries (required for decycled 
     81!   context, resort the bits and do some minor formatting.
     82! - Make flag initialization for scalars more flexible, introduce an
     83!   arguemnt list to indicate non-cyclic boundaries (required for decycled
    7684!   scalars such as chemical species or aerosols)
    77 ! - Introduce extended 'degradation zones', where horizontal advection of 
    78 !   passive scalars is discretized by first-order scheme at all grid points 
    79 !   that in the vicinity of buildings (<= 3 grid points). Even though no 
    80 !   building is within the numerical stencil, first-order scheme is used. 
     85! - Introduce extended 'degradation zones', where horizontal advection of
     86!   passive scalars is discretized by first-order scheme at all grid points
     87!   that in the vicinity of buildings (<= 3 grid points). Even though no
     88!   building is within the numerical stencil, first-order scheme is used.
    8189!   At fourth and fifth grid point the order of the horizontal advection scheme
    8290!   is successively upgraded.
    83 !   These extended degradation zones are used to avoid stationary numerical 
     91!   These extended degradation zones are used to avoid stationary numerical
    8492!   oscillations, which are responsible for high concentration maxima that may
    85 !   appear under shear-free stable conditions. 
    86 ! - Change interface for scalar advection routine. 
     93!   appear under shear-free stable conditions.
     94! - Change interface for scalar advection routine.
    8795! - Bugfix, avoid uninitialized value sk_num in vector version of scalar
    8896!   advection
    89 ! 
     97!
    9098! 4109 2019-07-22 17:00:34Z suehring
    91 ! Implementation of a flux limiter according to Skamarock (2006) for the 
    92 ! vertical scalar advection. Please note, this is only implemented for the 
     99! Implementation of a flux limiter according to Skamarock (2006) for the
     100! vertical scalar advection. Please note, this is only implemented for the
    93101! cache-optimized version at the moment. Implementation for the vector-
    94 ! optimized version will follow after critical issues concerning 
     102! optimized version will follow after critical issues concerning
    95103! vectorization are fixed.
    96 ! 
     104!
    97105! 3873 2019-04-08 15:44:30Z knoop
    98106! Moved ocean_mode specific code to ocean_mod
    99 ! 
     107!
    100108! 3872 2019-04-08 15:03:06Z knoop
    101109! Moved all USE statements to module level + removed salsa dependency
    102 ! 
     110!
    103111! 3871 2019-04-08 14:38:39Z knoop
    104112! Moving initialization of bcm specific flux arrays into bulk_cloud_model_mod
    105 ! 
     113!
    106114! 3864 2019-04-05 09:01:56Z monakurppa
    107115! Remove tailing white spaces
    108 ! 
     116!
    109117! 3696 2019-01-24 16:37:35Z suehring
    110118! Bugfix in degradation height
    111 ! 
     119!
    112120! 3661 2019-01-08 18:22:50Z suehring
    113 ! - Minor bugfix in divergence correction (only has implications at 
     121! - Minor bugfix in divergence correction (only has implications at
    114122!   downward-facing wall surfaces)
    115123! - Remove setting of Neumann condition for horizontal velocity variances
    116124! - Split loops for tendency calculation and divergence correction in order to
    117125!   reduce bit queries
    118 ! - Introduce new parameter nzb_max_l to better control order degradation at 
     126! - Introduce new parameter nzb_max_l to better control order degradation at
    119127!   non-cyclic boundaries
    120 ! 
     128!
    121129! 3655 2019-01-07 16:51:22Z knoop
    122130! OpenACC port for SPEC
     
    133141! ------------
    134142!> Advection scheme for scalars and momentum using the flux formulation of
    135 !> Wicker and Skamarock 5th order. Additionally the module contains of a 
    136 !> routine using for initialisation and steering of the statical evaluation. 
     143!> Wicker and Skamarock 5th order. Additionally the module contains of a
     144!> routine using for initialisation and steering of the statical evaluation.
    137145!> The computation of turbulent fluxes takes place inside the advection
    138146!> routines.
     
    140148!> degraded.
    141149!> A divergence correction is applied. It is necessary for topography, since
    142 !> the divergence is not sufficiently reduced, resulting in erroneous fluxes 
    143 !> and could lead to numerical instabilities. 
     150!> the divergence is not sufficiently reduced, resulting in erroneous fluxes
     151!> and could lead to numerical instabilities.
    144152!>
    145153!> @todo Implement monotonic flux limiter also for vector version.
     
    154162               u_stokes_zu, v_stokes_zu,                                       &
    155163               diss_l_diss, diss_l_e, diss_l_pt, diss_l_q,                     &
    156                diss_l_s, diss_l_sa, diss_l_u, diss_l_v, diss_l_w,              &
     164               diss_l_s, diss_l_u, diss_l_v, diss_l_w,                         &
    157165               flux_l_diss, flux_l_e, flux_l_pt, flux_l_q, flux_l_s,           &
    158                flux_l_sa, flux_l_u, flux_l_v, flux_l_w,                        &
     166               flux_l_u, flux_l_v, flux_l_w,                                   &
    159167               diss_s_diss, diss_s_e, diss_s_pt, diss_s_q, diss_s_s,           &
    160                diss_s_sa, diss_s_u, diss_s_v, diss_s_w,                        &
     168               diss_s_u, diss_s_v, diss_s_w,                                   &
    161169               flux_s_diss, flux_s_e, flux_s_pt, flux_s_q, flux_s_s,           &
    162                flux_s_sa, flux_s_u, flux_s_v, flux_s_w
     170               flux_s_u, flux_s_v, flux_s_w
    163171
    164172    USE control_parameters,                                                    &
    165         ONLY:  air_chemistry,                                                  &
    166                bc_dirichlet_l,                                                 &
     173        ONLY:  bc_dirichlet_l,                                                 &
    167174               bc_dirichlet_n,                                                 &
    168175               bc_dirichlet_r,                                                 &
     
    176183               passive_scalar,                                                 &
    177184               rans_tke_e,                                                     &
    178                momentum_advec,                                                 &
    179                salsa,                                                          &
    180                scalar_advec,                                                   &
    181185               symmetry_flag,                                                  &
    182186               intermediate_timestep_count,                                    &
     
    186190               ws_scheme_sca,                                                  &
    187191               dt_3d
     192
     193    USE cpulog,                                                                &
     194        ONLY:  cpu_log,                                                        &
     195               log_point_s
    188196
    189197    USE exchange_horiz_mod,                                                    &
     
    198206               nxlg,                                                           &
    199207               nxlu,                                                           &
    200                nxr,                                                            & 
    201                nxrg,                                                           & 
     208               nxr,                                                            &
     209               nxrg,                                                           &
    202210               ny,                                                             &
    203                nyn,                                                            & 
    204                nyng,                                                           & 
     211               nyn,                                                            &
     212               nyng,                                                           &
    205213               nys,                                                            &
    206214               nysg,                                                           &
     
    242250    INTERFACE ws_init
    243251       MODULE PROCEDURE ws_init
    244     END INTERFACE ws_init         
    245              
     252    END INTERFACE ws_init
     253
    246254    INTERFACE ws_init_flags_momentum
    247255       MODULE PROCEDURE ws_init_flags_momentum
    248256    END INTERFACE ws_init_flags_momentum
    249    
     257
    250258    INTERFACE ws_init_flags_scalar
    251259       MODULE PROCEDURE ws_init_flags_scalar
     
    287295
    288296!
    289 !--    Set the appropriate factors for scalar and momentum advection.
     297!--    Set factors for scalar and momentum advection.
    290298       adv_sca_5 = 1.0_wp /  60.0_wp
    291299       adv_sca_3 = 1.0_wp /  12.0_wp
     
    294302       adv_mom_3 = 1.0_wp /  24.0_wp
    295303       adv_mom_1 = 1.0_wp /   4.0_wp
    296 !         
     304!
    297305!--    Arrays needed for statical evaluation of fluxes.
    298306       IF ( ws_scheme_mom )  THEN
     
    330338
    331339!
    332 !--    Arrays needed for reasons of speed optimization for cache version.
    333 !--    For the vector version the buffer arrays are not necessary,
    334 !--    because the the fluxes can swapped directly inside the loops of the
    335 !--    advection routines.
     340!--    Arrays needed for reasons of speed optimization
     341       IF ( ws_scheme_mom )  THEN
     342
     343          ALLOCATE( flux_s_u(nzb+1:nzt,0:threads_per_task-1),               &
     344                    flux_s_v(nzb+1:nzt,0:threads_per_task-1),               &
     345                    flux_s_w(nzb+1:nzt,0:threads_per_task-1),               &
     346                    diss_s_u(nzb+1:nzt,0:threads_per_task-1),               &
     347                    diss_s_v(nzb+1:nzt,0:threads_per_task-1),               &
     348                    diss_s_w(nzb+1:nzt,0:threads_per_task-1) )
     349          ALLOCATE( flux_l_u(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
     350                    flux_l_v(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
     351                    flux_l_w(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
     352                    diss_l_u(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
     353                    diss_l_v(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
     354                    diss_l_w(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
     355
     356       ENDIF
     357!
     358!--    For the vector version the buffer arrays for scalars are not necessary,
     359!--    since internal arrays are used in the vector version.
    336360       IF ( loop_optimization /= 'vector' )  THEN
    337 
    338           IF ( ws_scheme_mom )  THEN
    339 
    340              ALLOCATE( flux_s_u(nzb+1:nzt,0:threads_per_task-1),               &
    341                        flux_s_v(nzb+1:nzt,0:threads_per_task-1),               &
    342                        flux_s_w(nzb+1:nzt,0:threads_per_task-1),               &
    343                        diss_s_u(nzb+1:nzt,0:threads_per_task-1),               &
    344                        diss_s_v(nzb+1:nzt,0:threads_per_task-1),               &
    345                        diss_s_w(nzb+1:nzt,0:threads_per_task-1) )
    346              ALLOCATE( flux_l_u(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
    347                        flux_l_v(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
    348                        flux_l_w(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
    349                        diss_l_u(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
    350                        diss_l_v(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
    351                        diss_l_w(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
    352 
    353           ENDIF
    354 
    355361          IF ( ws_scheme_sca )  THEN
    356362
     
    358364                       flux_s_e(nzb+1:nzt,0:threads_per_task-1),               &
    359365                       diss_s_pt(nzb+1:nzt,0:threads_per_task-1),              &
    360                        diss_s_e(nzb+1:nzt,0:threads_per_task-1) ) 
     366                       diss_s_e(nzb+1:nzt,0:threads_per_task-1) )
    361367             ALLOCATE( flux_l_pt(nzb+1:nzt,nys:nyn,0:threads_per_task-1),      &
    362368                       flux_l_e(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
     
    386392
    387393          ENDIF
    388 
    389394       ENDIF
    390395!
    391 !--    Initialize the flag arrays controlling degradation near walls, i.e. 
     396!--    Initialize the flag arrays controlling degradation near walls, i.e.
    392397!--    to decrease the numerical stencil appropriately. The order of the scheme
    393398!--    is degraded near solid walls as well as near non-cyclic inflow and outflow
     
    412417!> Initialization of flags to control the order of the advection scheme near
    413418!> solid walls and non-cyclic inflow boundaries, where the order is sucessively
    414 !> degraded. 
     419!> degraded.
    415420!------------------------------------------------------------------------------!
    416421    SUBROUTINE ws_init_flags_momentum
     
    437442          DO  j = nys, nyn
    438443             DO  k = nzb+1, nzt
    439 ! 
    440 !--             At first, set flags to WS1. 
    441 !--             Since fluxes are swapped in advec_ws.f90, this is necessary to 
     444!
     445!--             At first, set flags to WS1.
     446!--             Since fluxes are swapped in advec_ws.f90, this is necessary to
    442447!--             in order to handle the left/south flux.
    443 !--             near vertical walls. 
     448!--             near vertical walls.
    444449                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 0 )
    445450                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 3 )
     
    452457                         ( ( bc_dirichlet_r .OR. bc_radiation_r )              &
    453458                           .AND. i == nxr   ) )                                &
    454                 THEN                                                           
    455                     advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 0 )     
     459                THEN
     460                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 0 )
    456461                ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i+2),1)  .AND.   &
    457462                                 BTEST(wall_flags_total_0(k,j,i+1),1)  .OR.    &
     
    462467                         ( ( bc_dirichlet_l .OR. bc_radiation_l )              &
    463468                           .AND. i == nxlu+1) )                                &
    464                 THEN                                                           
    465                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 1 )       
    466 !                                                                             
    467 !--                Clear flag for WS1                                         
    468                    advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 0 )       
    469                 ELSEIF ( BTEST(wall_flags_total_0(k,j,i+1),1)  .AND.          &
    470                          BTEST(wall_flags_total_0(k,j,i+2),1)  .AND.          &
    471                          BTEST(wall_flags_total_0(k,j,i-1),1) )               &
    472                 THEN                                                           
    473                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 2 )       
    474 !                                                                             
    475 !--                Clear flag for WS1                                         
    476                    advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 0 )       
    477                 ENDIF                                                         
    478 !                                                                             
    479 !--             u component - y-direction                                     
    480 !--             WS1 (3), WS3 (4), WS5 (5)                                       
     469                THEN
     470                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 1 )
     471!
     472!--                Clear flag for WS1
     473                   advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 0 )
     474                ELSEIF ( BTEST(wall_flags_total_0(k,j,i+1),1)  .AND.           &
     475                         BTEST(wall_flags_total_0(k,j,i+2),1)  .AND.           &
     476                         BTEST(wall_flags_total_0(k,j,i-1),1) )                &
     477                THEN
     478                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 2 )
     479!
     480!--                Clear flag for WS1
     481                   advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 0 )
     482                ENDIF
     483!
     484!--             u component - y-direction
     485!--             WS1 (3), WS3 (4), WS5 (5)
    481486                IF ( .NOT. BTEST(wall_flags_total_0(k,j+1,i),1)   .OR.         &
    482487                         ( ( bc_dirichlet_s .OR. bc_radiation_s )              &
     
    484489                         ( ( bc_dirichlet_n .OR. bc_radiation_n )              &
    485490                           .AND. j == nyn   ) )                                &
    486                 THEN                                                           
    487                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 3 )       
     491                THEN
     492                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 3 )
    488493                ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j+2,i),1)  .AND.   &
    489494                                 BTEST(wall_flags_total_0(k,j+1,i),1)  .OR.    &
     
    494499                         ( ( bc_dirichlet_n .OR. bc_radiation_n )              &
    495500                           .AND. j == nyn-1 ) )                                &
    496                 THEN                                                           
    497                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 4 )       
    498 !                                                                             
    499 !--                Clear flag for WS1                                         
    500                    advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 3 )       
     501                THEN
     502                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 4 )
     503!
     504!--                Clear flag for WS1
     505                   advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 3 )
    501506                ELSEIF ( BTEST(wall_flags_total_0(k,j+1,i),1)  .AND.          &
    502507                         BTEST(wall_flags_total_0(k,j+2,i),1)  .AND.          &
    503508                         BTEST(wall_flags_total_0(k,j-1,i),1) )               &
    504                 THEN                                                           
    505                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 5 )       
    506 !                                                                             
    507 !--                Clear flag for WS1                                         
    508                    advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 3 )       
    509                 ENDIF                                                         
    510 !                                                                             
    511 !--             u component - z-direction. Fluxes are calculated on w-grid                                     
    512 !--             level. Boundary u-values at/within walls aren't used. 
    513 !--             WS1 (6), WS3 (7), WS5 (8)                                     
    514                 IF ( k == nzb+1 )  THEN                                       
    515                    k_mm = nzb                                                 
    516                 ELSE                                                           
    517                    k_mm = k - 2                                               
    518                 ENDIF                                                         
    519                 IF ( k > nzt-1 )  THEN                                         
    520                    k_pp = nzt+1                                               
    521                 ELSE                                                           
    522                    k_pp = k + 2                                               
    523                 ENDIF                                                         
    524                 IF ( k > nzt-2 )  THEN                                         
    525                    k_ppp = nzt+1                                               
    526                 ELSE                                                           
    527                    k_ppp = k + 3                                               
    528                 ENDIF                                                         
    529                                                                                
    530                 flag_set = .FALSE.                                             
    531                 IF ( ( .NOT. BTEST(wall_flags_total_0(k-1,j,i),1)       .AND.     &
    532                              BTEST(wall_flags_total_0(k,j,i),1)         .AND.     &
    533                              BTEST(wall_flags_total_0(k+1,j,i),1) )     .OR.      &
    534                      ( .NOT. BTEST(wall_flags_total_0(k_pp,j,i),1)      .AND.     &                             
    535                              BTEST(wall_flags_total_0(k+1,j,i),1)       .AND.     &
    536                              BTEST(wall_flags_total_0(k,j,i),1) )       .OR.      &
    537                      ( k == nzt .AND. symmetry_flag == 0 ) )                      &
    538                 THEN                                                           
    539                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 6 )       
    540                    flag_set = .TRUE.                                           
    541                 ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k_mm,j,i),1)    .OR.    &
    542                            .NOT. BTEST(wall_flags_total_0(k_ppp,j,i),1) ) .AND.   &
    543                                  BTEST(wall_flags_total_0(k-1,j,i),1)     .AND.   &
    544                                  BTEST(wall_flags_total_0(k,j,i),1)       .AND.   &
    545                                  BTEST(wall_flags_total_0(k+1,j,i),1)     .AND.   &
    546                                  BTEST(wall_flags_total_0(k_pp,j,i),1)    .AND.   &
    547                            .NOT. flag_set                                  .OR.   &
    548                          ( k == nzt - 1 .AND. symmetry_flag == 0 ) )              &
    549                 THEN                                                           
    550                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 7 )       
    551                    flag_set = .TRUE.                                           
    552                 ELSEIF ( BTEST(wall_flags_total_0(k_mm,j,i),1)            .AND.   &
    553                          BTEST(wall_flags_total_0(k-1,j,i),1)             .AND.   &
    554                          BTEST(wall_flags_total_0(k,j,i),1)               .AND.   &
    555                          BTEST(wall_flags_total_0(k+1,j,i),1)             .AND.   &
    556                          BTEST(wall_flags_total_0(k_pp,j,i),1)            .AND.   &
    557                          BTEST(wall_flags_total_0(k_ppp,j,i),1)           .AND.   &
    558                          .NOT. flag_set )                                         &
     509                THEN
     510                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 5 )
     511!
     512!--                Clear flag for WS1
     513                   advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 3 )
     514                ENDIF
     515!
     516!--             u component - z-direction. Fluxes are calculated on w-grid
     517!--             level. Boundary u-values at/within walls aren't used.
     518!--             WS1 (6), WS3 (7), WS5 (8)
     519                IF ( k == nzb+1 )  THEN
     520                   k_mm = nzb
     521                ELSE
     522                   k_mm = k - 2
     523                ENDIF
     524                IF ( k > nzt-1 )  THEN
     525                   k_pp = nzt+1
     526                ELSE
     527                   k_pp = k + 2
     528                ENDIF
     529                IF ( k > nzt-2 )  THEN
     530                   k_ppp = nzt+1
     531                ELSE
     532                   k_ppp = k + 3
     533                ENDIF
     534
     535                flag_set = .FALSE.
     536                IF ( ( .NOT. BTEST(wall_flags_total_0(k-1,j,i),1)       .AND.  &
     537                             BTEST(wall_flags_total_0(k,j,i),1)         .AND.  &
     538                             BTEST(wall_flags_total_0(k+1,j,i),1) )     .OR.   &
     539                     ( .NOT. BTEST(wall_flags_total_0(k_pp,j,i),1)      .AND.  &
     540                             BTEST(wall_flags_total_0(k+1,j,i),1)       .AND.  &
     541                             BTEST(wall_flags_total_0(k,j,i),1) )       .OR.   &
     542                     ( k == nzt .AND. symmetry_flag == 0 ) )                   &
     543                THEN
     544                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 6 )
     545                   flag_set = .TRUE.
     546                ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k_mm,j,i),1)    .OR. &
     547                           .NOT. BTEST(wall_flags_total_0(k_ppp,j,i),1) ) .AND.&
     548                                 BTEST(wall_flags_total_0(k-1,j,i),1)     .AND.&
     549                                 BTEST(wall_flags_total_0(k,j,i),1)       .AND.&
     550                                 BTEST(wall_flags_total_0(k+1,j,i),1)     .AND.&
     551                                 BTEST(wall_flags_total_0(k_pp,j,i),1)    .AND.&
     552                           .NOT. flag_set                                  .OR.&
     553                         ( k == nzt - 1 .AND. symmetry_flag == 0 ) )           &
     554                THEN
     555                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 7 )
     556                   flag_set = .TRUE.
     557                ELSEIF ( BTEST(wall_flags_total_0(k_mm,j,i),1)            .AND.&
     558                         BTEST(wall_flags_total_0(k-1,j,i),1)             .AND.&
     559                         BTEST(wall_flags_total_0(k,j,i),1)               .AND.&
     560                         BTEST(wall_flags_total_0(k+1,j,i),1)             .AND.&
     561                         BTEST(wall_flags_total_0(k_pp,j,i),1)            .AND.&
     562                         BTEST(wall_flags_total_0(k_ppp,j,i),1)           .AND.&
     563                         .NOT. flag_set )                                      &
    559564                THEN
    560565                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 8 )
     
    570575             DO  k = nzb+1, nzt
    571576!
    572 !--             At first, set flags to WS1. 
    573 !--             Since fluxes are swapped in advec_ws.f90, this is necessary to 
     577!--             At first, set flags to WS1.
     578!--             Since fluxes are swapped in advec_ws.f90, this is necessary to
    574579!--             in order to handle the left/south flux.
    575580                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 9  )
     
    583588                         ( ( bc_dirichlet_r .OR. bc_radiation_r )              &
    584589                           .AND. i == nxr   ) )                                &
    585                THEN                                                           
    586                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 9 )       
    587 !                                                                             
    588 !--             WS3                                                           
     590               THEN
     591                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 9 )
     592!
     593!--             WS3
    589594                ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i+2),2)   .AND.  &
    590595                                 BTEST(wall_flags_total_0(k,j,i+1),2) ) .OR.   &
     
    595600                         ( ( bc_dirichlet_l .OR. bc_radiation_l )              &
    596601                           .AND. i == nxlu  ) )                                &
    597                 THEN                                                           
    598                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 10 )     
    599 !                                                                             
    600 !--                Clear flag for WS1                                         
    601                    advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 9 )     
     602                THEN
     603                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 10 )
     604!
     605!--                Clear flag for WS1
     606                   advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 9 )
    602607                ELSEIF ( BTEST(wall_flags_total_0(k,j,i+1),2)  .AND.           &
    603608                         BTEST(wall_flags_total_0(k,j,i+2),2)  .AND.           &
    604609                         BTEST(wall_flags_total_0(k,j,i-1),2) )                &
    605                 THEN                                                           
    606                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 11 )     
    607 !                                                                             
    608 !--                Clear flag for WS1                                         
    609                    advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 9 )       
    610                 ENDIF                                                         
    611 !                                                                             
    612 !--             v component - y-direction                                     
    613 !--             WS1 (12), WS3 (13), WS5 (14)                                   
     610                THEN
     611                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 11 )
     612!
     613!--                Clear flag for WS1
     614                   advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 9 )
     615                ENDIF
     616!
     617!--             v component - y-direction
     618!--             WS1 (12), WS3 (13), WS5 (14)
    614619                IF ( .NOT. BTEST(wall_flags_total_0(k,j+1,i),2) .OR.           &
    615620                         ( ( bc_dirichlet_s .OR. bc_radiation_s )              &
     
    617622                         ( ( bc_dirichlet_n .OR. bc_radiation_n )              &
    618623                           .AND. j == nyn   ) )                                &
    619                 THEN                                                           
    620                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 12 )     
     624                THEN
     625                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 12 )
    621626                ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j+2,i),2)  .AND.   &
    622627                                 BTEST(wall_flags_total_0(k,j+1,i),2)  .OR.    &
     
    627632                         ( (  bc_dirichlet_n .OR. bc_radiation_n )             &
    628633                           .AND. j == nyn-1 ) )                                &
    629                 THEN                                                           
    630                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 13 )     
    631 !                                                                             
    632 !--                Clear flag for WS1                                         
    633                    advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 12 )     
     634                THEN
     635                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 13 )
     636!
     637!--                Clear flag for WS1
     638                   advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 12 )
    634639                ELSEIF ( BTEST(wall_flags_total_0(k,j+1,i),2)  .AND.           &
    635640                         BTEST(wall_flags_total_0(k,j+2,i),2)  .AND.           &
    636                          BTEST(wall_flags_total_0(k,j-1,i),2) )                & 
    637                 THEN                                                         
     641                         BTEST(wall_flags_total_0(k,j-1,i),2) )                &
     642                THEN
    638643                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 14 )
    639644!
     
    641646                   advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 12 )
    642647                ENDIF
    643 !                                                             
    644 !--             v component - z-direction. Fluxes are calculated on w-grid                                     
    645 !--             level. Boundary v-values at/within walls aren't used. 
     648!
     649!--             v component - z-direction. Fluxes are calculated on w-grid
     650!--             level. Boundary v-values at/within walls aren't used.
    646651!--             WS1 (15), WS3 (16), WS5 (17)
    647652                IF ( k == nzb+1 )  THEN
    648653                   k_mm = nzb
    649                 ELSE 
     654                ELSE
    650655                   k_mm = k - 2
    651656                ENDIF
    652657                IF ( k > nzt-1 )  THEN
    653658                   k_pp = nzt+1
    654                 ELSE 
     659                ELSE
    655660                   k_pp = k + 2
    656661                ENDIF
    657662                IF ( k > nzt-2 )  THEN
    658663                   k_ppp = nzt+1
    659                 ELSE 
     664                ELSE
    660665                   k_ppp = k + 3
    661                 ENDIF 
    662                
     666                ENDIF
     667
    663668                flag_set = .FALSE.
    664                 IF ( ( .NOT. BTEST(wall_flags_total_0(k-1,j,i),2)          .AND.   &
    665                              BTEST(wall_flags_total_0(k,j,i),2)            .AND.   &
    666                              BTEST(wall_flags_total_0(k+1,j,i),2) )        .OR.    &
    667                      ( .NOT. BTEST(wall_flags_total_0(k_pp,j,i),2)         .AND.   &                             
    668                              BTEST(wall_flags_total_0(k+1,j,i),2)          .AND.   &
    669                              BTEST(wall_flags_total_0(k,j,i),2) )          .OR.    &
    670                      ( k == nzt .AND. symmetry_flag == 0 ) )                       &
    671                 THEN                                                           
    672                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 15 )     
    673                    flag_set = .TRUE.                                           
    674                 ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k_mm,j,i),2)    .OR.     &
    675                            .NOT. BTEST(wall_flags_total_0(k_ppp,j,i),2) ) .AND.    &
    676                                  BTEST(wall_flags_total_0(k-1,j,i),2)     .AND.    &
    677                                  BTEST(wall_flags_total_0(k,j,i),2)       .AND.    &
    678                                  BTEST(wall_flags_total_0(k+1,j,i),2)     .AND.    &
    679                                  BTEST(wall_flags_total_0(k_pp,j,i),2)    .AND.    &
    680                            .NOT. flag_set                                  .OR.    &
    681                          ( k == nzt - 1 .AND. symmetry_flag == 0 ) )               &
    682                 THEN                                                           
    683                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 16 )     
    684                    flag_set = .TRUE.                                           
    685                 ELSEIF ( BTEST(wall_flags_total_0(k_mm,j,i),2)             .AND.   &
    686                          BTEST(wall_flags_total_0(k-1,j,i),2)              .AND.   &
    687                          BTEST(wall_flags_total_0(k,j,i),2)                .AND.   &
    688                          BTEST(wall_flags_total_0(k+1,j,i),2)              .AND.   &
    689                          BTEST(wall_flags_total_0(k_pp,j,i),2)             .AND.   &
    690                          BTEST(wall_flags_total_0(k_ppp,j,i),2)            .AND.   &
    691                          .NOT. flag_set )                                          &
     669                IF ( ( .NOT. BTEST(wall_flags_total_0(k-1,j,i),2)         .AND.&
     670                             BTEST(wall_flags_total_0(k,j,i),2)           .AND.&
     671                             BTEST(wall_flags_total_0(k+1,j,i),2) )       .OR. &
     672                     ( .NOT. BTEST(wall_flags_total_0(k_pp,j,i),2)        .AND.&
     673                             BTEST(wall_flags_total_0(k+1,j,i),2)         .AND.&
     674                             BTEST(wall_flags_total_0(k,j,i),2) )         .OR. &
     675                     ( k == nzt .AND. symmetry_flag == 0 ) )                   &
     676                THEN
     677                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 15 )
     678                   flag_set = .TRUE.
     679                ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k_mm,j,i),2)    .OR. &
     680                           .NOT. BTEST(wall_flags_total_0(k_ppp,j,i),2) ) .AND.&
     681                                 BTEST(wall_flags_total_0(k-1,j,i),2)     .AND.&
     682                                 BTEST(wall_flags_total_0(k,j,i),2)       .AND.&
     683                                 BTEST(wall_flags_total_0(k+1,j,i),2)     .AND.&
     684                                 BTEST(wall_flags_total_0(k_pp,j,i),2)    .AND.&
     685                           .NOT. flag_set                                  .OR.&
     686                         ( k == nzt - 1 .AND. symmetry_flag == 0 ) )           &
     687                THEN
     688                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 16 )
     689                   flag_set = .TRUE.
     690                ELSEIF ( BTEST(wall_flags_total_0(k_mm,j,i),2)            .AND.&
     691                         BTEST(wall_flags_total_0(k-1,j,i),2)             .AND.&
     692                         BTEST(wall_flags_total_0(k,j,i),2)               .AND.&
     693                         BTEST(wall_flags_total_0(k+1,j,i),2)             .AND.&
     694                         BTEST(wall_flags_total_0(k_pp,j,i),2)            .AND.&
     695                         BTEST(wall_flags_total_0(k_ppp,j,i),2)           .AND.&
     696                         .NOT. flag_set )                                      &
    692697                THEN
    693698                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 17 )
     
    703708             DO  k = nzb+1, nzt
    704709!
    705 !--             At first, set flags to WS1. 
    706 !--             Since fluxes are swapped in advec_ws.f90, this is necessary to 
     710!--             At first, set flags to WS1.
     711!--             Since fluxes are swapped in advec_ws.f90, this is necessary to
    707712!--             in order to handle the left/south flux.
    708713                advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 18 )
     
    716721                         ( (  bc_dirichlet_r .OR. bc_radiation_r )             &
    717722                           .AND. i == nxr   ) )                                &
    718                 THEN                                                           
    719                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 18 )     
     723                THEN
     724                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 18 )
    720725                ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i+2),3)  .AND.   &
    721726                                 BTEST(wall_flags_total_0(k,j,i+1),3)  .OR.    &
     
    726731                         ( ( bc_dirichlet_l .OR.  bc_radiation_l )             &
    727732                           .AND. i == nxlu  ) )                                &
    728                 THEN                                                           
    729                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 19 )     
    730 !                                                                             
    731 !--                Clear flag for WS1                                         
    732                    advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 18 )     
     733                THEN
     734                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 19 )
     735!
     736!--                Clear flag for WS1
     737                   advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 18 )
    733738                ELSEIF ( BTEST(wall_flags_total_0(k,j,i+1),3)  .AND.           &
    734739                         BTEST(wall_flags_total_0(k,j,i+2),3)  .AND.           &
    735740                         BTEST(wall_flags_total_0(k,j,i-1),3) )                &
    736                 THEN                                                           
    737                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i),20 )       
    738 !                                                                             
    739 !--                Clear flag for WS1                                         
    740                    advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 18 )     
    741                 ENDIF                                                         
    742 !                                                                             
    743 !--             w component - y-direction                                     
    744 !--             WS1 (21), WS3 (22), WS5 (23)                                   
     741                THEN
     742                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i),20 )
     743!
     744!--                Clear flag for WS1
     745                   advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 18 )
     746                ENDIF
     747!
     748!--             w component - y-direction
     749!--             WS1 (21), WS3 (22), WS5 (23)
    745750                IF ( .NOT. BTEST(wall_flags_total_0(k,j+1,i),3) .OR.           &
    746751                         ( ( bc_dirichlet_s .OR. bc_radiation_s )              &
     
    748753                         ( ( bc_dirichlet_n .OR. bc_radiation_n )              &
    749754                           .AND. j == nyn   ) )                                &
    750                 THEN                                                           
    751                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 21 )     
     755                THEN
     756                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 21 )
    752757                ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j+2,i),3)  .AND.   &
    753758                                 BTEST(wall_flags_total_0(k,j+1,i),3)  .OR.    &
     
    758763                         ( ( bc_dirichlet_n .OR. bc_radiation_n )              &
    759764                           .AND. j == nyn-1 ) )                                &
    760                 THEN                                                           
    761                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 22 )     
    762 !                                                                             
    763 !--                Clear flag for WS1                                         
    764                    advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 21 )       
     765                THEN
     766                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 22 )
     767!
     768!--                Clear flag for WS1
     769                   advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 21 )
    765770                ELSEIF ( BTEST(wall_flags_total_0(k,j+1,i),3)  .AND.           &
    766771                         BTEST(wall_flags_total_0(k,j+2,i),3)  .AND.           &
    767772                         BTEST(wall_flags_total_0(k,j-1,i),3) )                &
    768                 THEN                                                           
     773                THEN
    769774                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 23 )
    770775!
     
    772777                   advc_flags_m(k,j,i) = IBCLR( advc_flags_m(k,j,i), 21 )
    773778                ENDIF
    774 !                                                                             
     779!
    775780!--             w component - z-direction. Fluxes are calculated on scalar grid
    776 !--             level. Boundary w-values at walls are used. Flux at k=i is 
    777 !--             defined at scalar position k=i+1 with i being an integer. 
     781!--             level. Boundary w-values at walls are used. Flux at k=i is
     782!--             defined at scalar position k=i+1 with i being an integer.
    778783!--             WS1 (24), WS3 (25), WS5 (26)
    779784                IF ( k == nzb+1 )  THEN
     
    784789                IF ( k > nzt-1 )  THEN
    785790                   k_pp = nzt+1
    786                 ELSE 
     791                ELSE
    787792                   k_pp = k + 2
    788793                ENDIF
    789794                IF ( k > nzt-2 )  THEN
    790795                   k_ppp = nzt+1
    791                 ELSE 
     796                ELSE
    792797                   k_ppp = k + 3
    793                 ENDIF 
    794                
    795                 flag_set = .FALSE.                                       
    796                 IF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i),3)          .AND.   &
    797                              BTEST(wall_flags_total_0(k+1,j,i),3) )      .OR.    &
    798                      ( .NOT. BTEST(wall_flags_total_0(k+1,j,i),3)        .AND.   &
    799                              BTEST(wall_flags_total_0(k,j,i),3) )        .OR.    &       
    800                      k == nzt -1 )                                               &
     798                ENDIF
     799
     800                flag_set = .FALSE.
     801                IF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i),3)          .AND. &
     802                             BTEST(wall_flags_total_0(k+1,j,i),3) )      .OR.  &
     803                     ( .NOT. BTEST(wall_flags_total_0(k+1,j,i),3)        .AND. &
     804                             BTEST(wall_flags_total_0(k,j,i),3) )        .OR.  &
     805                     k == nzt -1 )                                             &
    801806                THEN
    802807!
    803808!--                Please note, at k == nzb_w_inner(j,i) a flag is explicitly
    804 !--                set, although this is not a prognostic level. However, 
     809!--                set, although this is not a prognostic level. However,
    805810!--                contrary to the advection of u,v and s this is necessary
    806811!--                because flux_t(nzb_w_inner(j,i)) is used for the tendency
     
    808813                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 24 )
    809814                   flag_set = .TRUE.
    810                 ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k-1,j,i),3)    .AND.   &
    811                                  BTEST(wall_flags_total_0(k,j,i),3)      .AND.   &
    812                                  BTEST(wall_flags_total_0(k+1,j,i),3)    .AND.   &
    813                                  BTEST(wall_flags_total_0(k_pp,j,i),3) ) .OR.    &
    814                          ( .NOT. BTEST(wall_flags_total_0(k_pp,j,i),3)   .AND.   &
    815                                  BTEST(wall_flags_total_0(k+1,j,i),3)    .AND.   &
    816                                  BTEST(wall_flags_total_0(k,j,i),3)      .AND.   &
    817                                  BTEST(wall_flags_total_0(k-1,j,i),3) )  .AND.   &
    818                            .NOT. flag_set                          .OR.          &
    819                          k == nzt - 2 )                                          &
    820                 THEN                                                           
    821                    advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 25 )     
    822                    flag_set = .TRUE.                                           
    823                 ELSEIF ( BTEST(wall_flags_total_0(k-1,j,i),3)            .AND.   &
    824                          BTEST(wall_flags_total_0(k,j,i),3)              .AND.   &
    825                          BTEST(wall_flags_total_0(k+1,j,i),3)            .AND.   &
    826                          BTEST(wall_flags_total_0(k_pp,j,i),3)           .AND.   &
    827                          .NOT. flag_set )                                        &
    828                 THEN                                                               
     815                ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k-1,j,i),3)    .AND. &
     816                                 BTEST(wall_flags_total_0(k,j,i),3)      .AND. &
     817                                 BTEST(wall_flags_total_0(k+1,j,i),3)    .AND. &
     818                                 BTEST(wall_flags_total_0(k_pp,j,i),3) ) .OR.  &
     819                         ( .NOT. BTEST(wall_flags_total_0(k_pp,j,i),3)   .AND. &
     820                                 BTEST(wall_flags_total_0(k+1,j,i),3)    .AND. &
     821                                 BTEST(wall_flags_total_0(k,j,i),3)      .AND. &
     822                                 BTEST(wall_flags_total_0(k-1,j,i),3) )  .AND. &
     823                           .NOT. flag_set                          .OR.        &
     824                         k == nzt - 2 )                                        &
     825                THEN
     826                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 25 )
     827                   flag_set = .TRUE.
     828                ELSEIF ( BTEST(wall_flags_total_0(k-1,j,i),3)            .AND. &
     829                         BTEST(wall_flags_total_0(k,j,i),3)              .AND. &
     830                         BTEST(wall_flags_total_0(k+1,j,i),3)            .AND. &
     831                         BTEST(wall_flags_total_0(k_pp,j,i),3)           .AND. &
     832                         .NOT. flag_set )                                      &
     833                THEN
    829834                   advc_flags_m(k,j,i) = IBSET( advc_flags_m(k,j,i), 26 )
    830835                ENDIF
     
    837842       CALL exchange_horiz_int( advc_flags_m, nys, nyn, nxl, nxr, nzt, nbgp )
    838843!
    839 !--    Set boundary flags at inflow and outflow boundary in case of 
     844!--    Set boundary flags at inflow and outflow boundary in case of
    840845!--    non-cyclic boundary conditions.
    841846       IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
     
    844849
    845850       IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
    846          advc_flags_m(:,:,nxr+1) = advc_flags_m(:,:,nxr)
     851          advc_flags_m(:,:,nxr+1) = advc_flags_m(:,:,nxr)
    847852       ENDIF
    848853
     
    863868!> Initialization of flags to control the order of the advection scheme near
    864869!> solid walls and non-cyclic inflow boundaries, where the order is sucessively
    865 !> degraded. 
     870!> degraded.
    866871!------------------------------------------------------------------------------!
    867872    SUBROUTINE ws_init_flags_scalar( non_cyclic_l, non_cyclic_n, non_cyclic_r, &
     
    885890       LOGICAL ::  non_cyclic_s !< flag that indicates non-cyclic boundary on the south
    886891
    887        LOGICAL, OPTIONAL ::  extensive_degrad !< flag indicating that extensive degradation is required, e.g. for 
     892       LOGICAL, OPTIONAL ::  extensive_degrad !< flag indicating that extensive degradation is required, e.g. for
    888893                                              !< passive scalars nearby topography along the horizontal directions,
    889                                               !< as no monotonic limiter can be applied there 
     894                                              !< as no monotonic limiter can be applied there
    890895!
    891896!--    Set flags to steer the degradation of the advection scheme in advec_ws
     
    900905!--             scalar - x-direction
    901906!--             WS1 (0), WS3 (1), WS5 (2)
    902                 IF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i+1),0)      .OR.      &
    903                        .NOT. BTEST(wall_flags_total_0(k,j,i+2),0)      .OR.      &   
    904                        .NOT. BTEST(wall_flags_total_0(k,j,i-1),0) )    .OR.      &
    905                        ( non_cyclic_l  .AND.  i == 0  )                .OR.      &
    906                        ( non_cyclic_r  .AND.  i == nx ) )  THEN           
    907                  advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 0 )             
    908                 ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i+3),0)  .AND.     &
    909                                  BTEST(wall_flags_total_0(k,j,i+1),0)  .AND.     &
    910                                  BTEST(wall_flags_total_0(k,j,i+2),0)  .AND.     &
    911                                  BTEST(wall_flags_total_0(k,j,i-1),0)            &
    912                          )                       .OR.                            &
    913                          ( .NOT. BTEST(wall_flags_total_0(k,j,i-2),0)  .AND.     &
    914                                  BTEST(wall_flags_total_0(k,j,i+1),0)  .AND.     &
    915                                  BTEST(wall_flags_total_0(k,j,i+2),0)  .AND.     &
    916                                  BTEST(wall_flags_total_0(k,j,i-1),0)            &
    917                          )                                                       &
    918                                                  .OR.                            &
    919                          ( non_cyclic_r  .AND.  i == nx-1 )  .OR.                &
    920                          ( non_cyclic_l  .AND.  i == 1    ) )  THEN           
    921                    advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 1 )             
    922                 ELSEIF ( BTEST(wall_flags_total_0(k,j,i+1),0)           .AND.    &
    923                          BTEST(wall_flags_total_0(k,j,i+2),0)           .AND.    &
    924                          BTEST(wall_flags_total_0(k,j,i+3),0)           .AND.    &
    925                          BTEST(wall_flags_total_0(k,j,i-1),0)           .AND.    &
    926                          BTEST(wall_flags_total_0(k,j,i-2),0) )                  &
    927                 THEN                                                           
    928                    advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 2 )             
    929                 ENDIF                                                         
    930 !                                                                             
    931 !--             scalar - y-direction                                           
    932 !--             WS1 (3), WS3 (4), WS5 (5)                                     
    933                 IF ( ( .NOT. BTEST(wall_flags_total_0(k,j+1,i),0)        .OR.    &
    934                        .NOT. BTEST(wall_flags_total_0(k,j+2,i),0)        .OR.    &   
    935                        .NOT. BTEST(wall_flags_total_0(k,j-1,i),0))       .OR.    &
    936                      ( non_cyclic_s  .AND.  j == 0  )                    .OR.    &
    937                      ( non_cyclic_n  .AND.  j == ny ) )  THEN                                                           
    938                    advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 3 )             
    939 !                                                                             
    940 !--             WS3                                                           
    941                 ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j+3,i),0)    .AND.   &
    942                                  BTEST(wall_flags_total_0(k,j+1,i),0)    .AND.   &
    943                                  BTEST(wall_flags_total_0(k,j+2,i),0)    .AND.   &
    944                                  BTEST(wall_flags_total_0(k,j-1,i),0)            &
    945                          )                       .OR.                            &
    946                          ( .NOT. BTEST(wall_flags_total_0(k,j-2,i),0)    .AND.   &
    947                                  BTEST(wall_flags_total_0(k,j+1,i),0)    .AND.   &
    948                                  BTEST(wall_flags_total_0(k,j+2,i),0)    .AND.   &
    949                                  BTEST(wall_flags_total_0(k,j-1,i),0)            &
    950                          )                                                       &
    951                                                  .OR.                            &
    952                          ( non_cyclic_s  .AND.  j == 1    )  .OR.                &
    953                          ( non_cyclic_n  .AND.  j == ny-1 ) )  THEN           
    954                    advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 4 )             
    955 !                                                                             
    956 !--             WS5                                                           
    957                 ELSEIF ( BTEST(wall_flags_total_0(k,j+1,i),0)           .AND.    &
    958                          BTEST(wall_flags_total_0(k,j+2,i),0)           .AND.    &
    959                          BTEST(wall_flags_total_0(k,j+3,i),0)           .AND.    &
    960                          BTEST(wall_flags_total_0(k,j-1,i),0)           .AND.    &
    961                          BTEST(wall_flags_total_0(k,j-2,i),0) )                  &
    962                 THEN                                                           
    963                    advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 5 )             
     907                IF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i+1),0)      .OR.    &
     908                       .NOT. BTEST(wall_flags_total_0(k,j,i+2),0)      .OR.    &
     909                       .NOT. BTEST(wall_flags_total_0(k,j,i-1),0) )    .OR.    &
     910                       ( non_cyclic_l  .AND.  i == 0  )                .OR.    &
     911                       ( non_cyclic_r  .AND.  i == nx ) )  THEN
     912                 advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 0 )
     913                ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j,i+3),0)  .AND.   &
     914                                 BTEST(wall_flags_total_0(k,j,i+1),0)  .AND.   &
     915                                 BTEST(wall_flags_total_0(k,j,i+2),0)  .AND.   &
     916                                 BTEST(wall_flags_total_0(k,j,i-1),0)          &
     917                         )                       .OR.                          &
     918                         ( .NOT. BTEST(wall_flags_total_0(k,j,i-2),0)  .AND.   &
     919                                 BTEST(wall_flags_total_0(k,j,i+1),0)  .AND.   &
     920                                 BTEST(wall_flags_total_0(k,j,i+2),0)  .AND.   &
     921                                 BTEST(wall_flags_total_0(k,j,i-1),0)          &
     922                         )                                                     &
     923                                                 .OR.                          &
     924                         ( non_cyclic_r  .AND.  i == nx-1 )  .OR.              &
     925                         ( non_cyclic_l  .AND.  i == 1    ) )  THEN
     926                   advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 1 )
     927                ELSEIF ( BTEST(wall_flags_total_0(k,j,i+1),0)           .AND.  &
     928                         BTEST(wall_flags_total_0(k,j,i+2),0)           .AND.  &
     929                         BTEST(wall_flags_total_0(k,j,i+3),0)           .AND.  &
     930                         BTEST(wall_flags_total_0(k,j,i-1),0)           .AND.  &
     931                         BTEST(wall_flags_total_0(k,j,i-2),0) )                &
     932                THEN
     933                   advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 2 )
    964934                ENDIF
    965935!
    966 !--             Near topography, set horizontal advection scheme to 1st order
    967 !--             for passive scalars, even if only one direction may be
     936!--             scalar - y-direction
     937!--             WS1 (3), WS3 (4), WS5 (5)
     938                IF ( ( .NOT. BTEST(wall_flags_total_0(k,j+1,i),0)        .OR.  &
     939                       .NOT. BTEST(wall_flags_total_0(k,j+2,i),0)        .OR.  &
     940                       .NOT. BTEST(wall_flags_total_0(k,j-1,i),0))       .OR.  &
     941                     ( non_cyclic_s  .AND.  j == 0  )                    .OR.  &
     942                     ( non_cyclic_n  .AND.  j == ny ) )  THEN
     943                   advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 3 )
     944!
     945!--             WS3
     946                ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k,j+3,i),0)    .AND. &
     947                                 BTEST(wall_flags_total_0(k,j+1,i),0)    .AND. &
     948                                 BTEST(wall_flags_total_0(k,j+2,i),0)    .AND. &
     949                                 BTEST(wall_flags_total_0(k,j-1,i),0)          &
     950                         )                       .OR.                          &
     951                         ( .NOT. BTEST(wall_flags_total_0(k,j-2,i),0)    .AND. &
     952                                 BTEST(wall_flags_total_0(k,j+1,i),0)    .AND. &
     953                                 BTEST(wall_flags_total_0(k,j+2,i),0)    .AND. &
     954                                 BTEST(wall_flags_total_0(k,j-1,i),0)          &
     955                         )                                                     &
     956                                                 .OR.                          &
     957                         ( non_cyclic_s  .AND.  j == 1    )  .OR.              &
     958                         ( non_cyclic_n  .AND.  j == ny-1 ) )  THEN
     959                   advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 4 )
     960!
     961!--             WS5
     962                ELSEIF ( BTEST(wall_flags_total_0(k,j+1,i),0)           .AND.  &
     963                         BTEST(wall_flags_total_0(k,j+2,i),0)           .AND.  &
     964                         BTEST(wall_flags_total_0(k,j+3,i),0)           .AND.  &
     965                         BTEST(wall_flags_total_0(k,j-1,i),0)           .AND.  &
     966                         BTEST(wall_flags_total_0(k,j-2,i),0) )                &
     967                THEN
     968                   advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 5 )
     969                ENDIF
     970!
     971!--             Near topography, set horizontal advection scheme to 1st order
     972!--             for passive scalars, even if only one direction may be
    968973!--             blocked by topography. These locations will be identified
    969 !--             by wall_flags_total_0 bit 31. Note, since several modules define 
    970 !--             advection flags but may apply different scalar boundary 
    971 !--             conditions, bit 31 is temporarily stored on advc_flags. 
    972 !--             Moreover, note that this extended degradtion for passive 
    973 !--             scalars is not required for the vertical direction as there 
    974 !--             the monotonic limiter can be applied. 
     974!--             by wall_flags_total_0 bit 31. Note, since several modules define
     975!--             advection flags but may apply different scalar boundary
     976!--             conditions, bit 31 is temporarily stored on advc_flags.
     977!--             Moreover, note that this extended degradtion for passive
     978!--             scalars is not required for the vertical direction as there
     979!--             the monotonic limiter can be applied.
    975980                IF ( PRESENT( extensive_degrad ) )  THEN
    976981                   IF ( extensive_degrad )  THEN
     
    980985                      IF( BTEST( advc_flag(k,j,i), 31 ) )  THEN
    981986!
    982 !--                      Clear flags that might indicate higher-order 
     987!--                      Clear flags that might indicate higher-order
    983988!--                      advection along x- and y-direction.
    984989                         advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 1 )
     
    990995!--                      x- and y-direction.
    991996                         advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 0 )
    992                          advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 3 ) 
     997                         advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 3 )
    993998                      ENDIF
    994999!
    9951000!--                   Adjacent to this extended degradation zone, successively
    996 !--                   upgrade the order of the scheme if this grid point isn't 
    997 !--                   flagged with bit 31 (indicating extended degradation 
    998 !--                   zone). 
     1001!--                   upgrade the order of the scheme if this grid point isn't
     1002!--                   flagged with bit 31 (indicating extended degradation
     1003!--                   zone).
    9991004                      IF ( .NOT. BTEST( advc_flag(k,j,i), 31 ) )  THEN
    10001005!
    10011006!--                      x-direction. First, clear all previous settings, than
    10021007!--                      set flag for 3rd-order scheme.
    1003                          IF ( BTEST( advc_flag(k,j,i-1), 31 )  .AND.        &
     1008                         IF ( BTEST( advc_flag(k,j,i-1), 31 )  .AND.           &
    10041009                              BTEST( advc_flag(k,j,i+1), 31 ) )  THEN
    10051010                            advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 0 )
    10061011                            advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 1 )
    10071012                            advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 2 )
    1008                            
     1013
    10091014                            advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 1 )
    10101015                         ENDIF
     
    10121017!--                      x-direction. First, clear all previous settings, than
    10131018!--                      set flag for 5rd-order scheme.
    1014                          IF ( .NOT. BTEST( advc_flag(k,j,i-1), 31 )  .AND.  &
    1015                                     BTEST( advc_flag(k,j,i-2), 31 )  .AND.  &
    1016                               .NOT. BTEST( advc_flag(k,j,i+1), 31 )  .AND.  &
     1019                         IF ( .NOT. BTEST( advc_flag(k,j,i-1), 31 )  .AND.     &
     1020                                    BTEST( advc_flag(k,j,i-2), 31 )  .AND.     &
     1021                              .NOT. BTEST( advc_flag(k,j,i+1), 31 )  .AND.     &
    10171022                                    BTEST( advc_flag(k,j,i+2), 31 ) )  THEN
    10181023                            advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 0 )
    10191024                            advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 1 )
    10201025                            advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 2 )
    1021                            
     1026
    10221027                            advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 2 )
    10231028                         ENDIF
     
    10251030!--                      y-direction. First, clear all previous settings, than
    10261031!--                      set flag for 3rd-order scheme.
    1027                          IF ( BTEST( advc_flag(k,j-1,i), 31 )  .AND.        &
     1032                         IF ( BTEST( advc_flag(k,j-1,i), 31 )  .AND.           &
    10281033                              BTEST( advc_flag(k,j+1,i), 31 ) )  THEN
    10291034                            advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 3 )
    10301035                            advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 4 )
    10311036                            advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 5 )
    1032                            
     1037
    10331038                            advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 4 )
    10341039                         ENDIF
     
    10361041!--                      y-direction. First, clear all previous settings, than
    10371042!--                      set flag for 5rd-order scheme.
    1038                          IF ( .NOT. BTEST( advc_flag(k,j-1,i), 31 )  .AND.  &
    1039                                     BTEST( advc_flag(k,j-2,i), 31 )  .AND.  &
    1040                               .NOT. BTEST( advc_flag(k,j+1,i), 31 )  .AND.  &
     1043                         IF ( .NOT. BTEST( advc_flag(k,j-1,i), 31 )  .AND.     &
     1044                                    BTEST( advc_flag(k,j-2,i), 31 )  .AND.     &
     1045                              .NOT. BTEST( advc_flag(k,j+1,i), 31 )  .AND.     &
    10411046                                    BTEST( advc_flag(k,j+2,i), 31 ) )  THEN
    10421047                            advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 3 )
    10431048                            advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 4 )
    10441049                            advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 5 )
    1045                            
     1050
    10461051                            advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 5 )
    10471052                         ENDIF
    10481053                      ENDIF
    1049                    
     1054
    10501055                   ENDIF
    1051                    
     1056
    10521057!
    10531058!--                Near lateral boundary flags might be overwritten. Set
    1054 !--                them again. 
     1059!--                them again.
    10551060!--                x-direction
    1056                    IF ( ( non_cyclic_l  .AND.  i == 0  )  .OR.             &
     1061                   IF ( ( non_cyclic_l  .AND.  i == 0  )  .OR.                 &
    10571062                        ( non_cyclic_r  .AND.  i == nx ) )  THEN
    10581063                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 0 )
    10591064                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 1 )
    10601065                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 2 )
    1061                          
     1066
    10621067                      advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 0 )
    10631068                   ENDIF
    1064                    
    1065                    IF ( ( non_cyclic_l  .AND.  i == 1    )  .OR.           &
     1069
     1070                   IF ( ( non_cyclic_l  .AND.  i == 1    )  .OR.               &
    10661071                        ( non_cyclic_r  .AND.  i == nx-1 ) )  THEN
    10671072                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 0 )
    10681073                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 1 )
    10691074                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 2 )
    1070                          
     1075
    10711076                      advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 1 )
    10721077                   ENDIF
    10731078!
    10741079!--                y-direction
    1075                    IF ( ( non_cyclic_n  .AND.  j == 0  )  .OR.             &
     1080                   IF ( ( non_cyclic_n  .AND.  j == 0  )  .OR.                 &
    10761081                        ( non_cyclic_s  .AND.  j == ny ) )  THEN
    10771082                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 3 )
    10781083                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 4 )
    10791084                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 5 )
    1080                          
     1085
    10811086                      advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 3 )
    10821087                   ENDIF
    1083                    
    1084                    IF ( ( non_cyclic_n  .AND.  j == 1    )  .OR.           &
     1088
     1089                   IF ( ( non_cyclic_n  .AND.  j == 1    )  .OR.               &
    10851090                        ( non_cyclic_s  .AND.  j == ny-1 ) )  THEN
    10861091                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 3 )
    10871092                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 4 )
    10881093                      advc_flag(k,j,i) = IBCLR( advc_flag(k,j,i), 5 )
    1089                          
     1094
    10901095                      advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 4 )
    10911096                   ENDIF
    1092                    
     1097
    10931098                ENDIF
    1094                
    1095                
    1096 !                                                                             
    1097 !--             scalar - z-direction. Fluxes are calculated on w-grid                                     
    1098 !--             level. Boundary values at/within walls aren't used.                                           
    1099 !--             WS1 (6), WS3 (7), WS5 (8)                                     
    1100                 IF ( k == nzb+1 )  THEN                                       
    1101                    k_mm = nzb                                                 
    1102                 ELSE                                                           
    1103                    k_mm = k - 2                                               
    1104                 ENDIF                                                         
    1105                 IF ( k > nzt-1 )  THEN                                         
    1106                    k_pp = nzt+1                                               
    1107                 ELSE                                                           
    1108                    k_pp = k + 2                                               
    1109                 ENDIF                                                         
    1110                 IF ( k > nzt-2 )  THEN                                         
    1111                    k_ppp = nzt+1                                               
    1112                 ELSE                                                           
    1113                    k_ppp = k + 3                                               
    1114                 ENDIF                                                         
    1115                                                                                
    1116                 flag_set = .FALSE.                                             
    1117                 IF ( ( .NOT. BTEST(wall_flags_total_0(k-1,j,i),0)          .AND.  &
    1118                              BTEST(wall_flags_total_0(k,j,i),0)            .AND.  &
    1119                              BTEST(wall_flags_total_0(k+1,j,i),0) )        .OR.   &
    1120                      ( .NOT. BTEST(wall_flags_total_0(k_pp,j,i),0)         .AND.  &                             
    1121                              BTEST(wall_flags_total_0(k+1,j,i),0)          .AND.  &
    1122                              BTEST(wall_flags_total_0(k,j,i),0) )          .OR.   &
    1123                      ( k == nzt .AND. symmetry_flag == 0 ) )                      &
    1124                 THEN                                                           
    1125                    advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 6 )             
    1126                    flag_set = .TRUE.                                           
    1127                 ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k_mm,j,i),0)    .OR.    &
    1128                            .NOT. BTEST(wall_flags_total_0(k_ppp,j,i),0) ) .AND.   &
    1129                                  BTEST(wall_flags_total_0(k-1,j,i),0)     .AND.   &
    1130                                  BTEST(wall_flags_total_0(k,j,i),0)       .AND.   &
    1131                                  BTEST(wall_flags_total_0(k+1,j,i),0)     .AND.   &
    1132                                  BTEST(wall_flags_total_0(k_pp,j,i),0)    .AND.   &
    1133                            .NOT. flag_set                                  .OR.   &
    1134                          ( k == nzt - 1 .AND. symmetry_flag == 0 ) )              &
    1135                 THEN                                                           
    1136                    advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 7 )             
    1137                    flag_set = .TRUE.                                           
    1138                 ELSEIF ( BTEST(wall_flags_total_0(k_mm,j,i),0)            .AND.   &
    1139                          BTEST(wall_flags_total_0(k-1,j,i),0)             .AND.   &
    1140                          BTEST(wall_flags_total_0(k,j,i),0)               .AND.   &
    1141                          BTEST(wall_flags_total_0(k+1,j,i),0)             .AND.   &
    1142                          BTEST(wall_flags_total_0(k_pp,j,i),0)            .AND.   &
    1143                          BTEST(wall_flags_total_0(k_ppp,j,i),0)           .AND.   &
    1144                         .NOT. flag_set )                                          &
     1099
     1100
     1101!
     1102!--             scalar - z-direction. Fluxes are calculated on w-grid
     1103!--             level. Boundary values at/within walls aren't used.
     1104!--             WS1 (6), WS3 (7), WS5 (8)
     1105                IF ( k == nzb+1 )  THEN
     1106                   k_mm = nzb
     1107                ELSE
     1108                   k_mm = k - 2
     1109                ENDIF
     1110                IF ( k > nzt-1 )  THEN
     1111                   k_pp = nzt+1
     1112                ELSE
     1113                   k_pp = k + 2
     1114                ENDIF
     1115                IF ( k > nzt-2 )  THEN
     1116                   k_ppp = nzt+1
     1117                ELSE
     1118                   k_ppp = k + 3
     1119                ENDIF
     1120
     1121                flag_set = .FALSE.
     1122                IF ( ( .NOT. BTEST(wall_flags_total_0(k-1,j,i),0)       .AND.  &
     1123                             BTEST(wall_flags_total_0(k,j,i),0)         .AND.  &
     1124                             BTEST(wall_flags_total_0(k+1,j,i),0) )     .OR.   &
     1125                     ( .NOT. BTEST(wall_flags_total_0(k_pp,j,i),0)      .AND.  &
     1126                             BTEST(wall_flags_total_0(k+1,j,i),0)       .AND.  &
     1127                             BTEST(wall_flags_total_0(k,j,i),0) )       .OR.   &
     1128                     ( k == nzt .AND. symmetry_flag == 0 ) )                   &
     1129                THEN
     1130                   advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 6 )
     1131                   flag_set = .TRUE.
     1132                ELSEIF ( ( .NOT. BTEST(wall_flags_total_0(k_mm,j,i),0)    .OR. &
     1133                           .NOT. BTEST(wall_flags_total_0(k_ppp,j,i),0) ) .AND.&
     1134                                 BTEST(wall_flags_total_0(k-1,j,i),0)     .AND.&
     1135                                 BTEST(wall_flags_total_0(k,j,i),0)       .AND.&
     1136                                 BTEST(wall_flags_total_0(k+1,j,i),0)     .AND.&
     1137                                 BTEST(wall_flags_total_0(k_pp,j,i),0)    .AND.&
     1138                           .NOT. flag_set                                  .OR.&
     1139                         ( k == nzt - 1 .AND. symmetry_flag == 0 ) )           &
     1140                THEN
     1141                   advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 7 )
     1142                   flag_set = .TRUE.
     1143                ELSEIF ( BTEST(wall_flags_total_0(k_mm,j,i),0)         .AND.   &
     1144                         BTEST(wall_flags_total_0(k-1,j,i),0)          .AND.   &
     1145                         BTEST(wall_flags_total_0(k,j,i),0)            .AND.   &
     1146                         BTEST(wall_flags_total_0(k+1,j,i),0)          .AND.   &
     1147                         BTEST(wall_flags_total_0(k_pp,j,i),0)         .AND.   &
     1148                         BTEST(wall_flags_total_0(k_ppp,j,i),0)        .AND.   &
     1149                        .NOT. flag_set )                                       &
    11451150                THEN
    11461151                   advc_flag(k,j,i) = IBSET( advc_flag(k,j,i), 8 )
     
    11561161       CALL exchange_horiz_int( advc_flag, nys, nyn, nxl, nxr, nzt, nbgp )
    11571162!
    1158 !--    Set boundary flags at inflow and outflow boundary in case of 
     1163!--    Set boundary flags at inflow and outflow boundary in case of
    11591164!--    non-cyclic boundary conditions.
    11601165       IF ( non_cyclic_l )  THEN
     
    11731178          advc_flag(:,nys-1,:) = advc_flag(:,nys,:)
    11741179       ENDIF
    1175  
    1176 
    1177 
    1178     END SUBROUTINE ws_init_flags_scalar   
    1179    
     1180
     1181
     1182
     1183    END SUBROUTINE ws_init_flags_scalar
     1184
    11801185!------------------------------------------------------------------------------!
    11811186! Description:
     
    11871192
    11881193!
    1189 !--    The arrays needed for statistical evaluation are set to to 0 at the 
     1194!--    The arrays needed for statistical evaluation are set to to 0 at the
    11901195!--    beginning of prognostic_equations.
    11911196       IF ( ws_scheme_mom )  THEN
     
    12251230
    12261231
    1227        CHARACTER (LEN = *), INTENT(IN) ::  sk_char !< string identifier, used for assign fluxes to the correct dimension in the analysis array
    1228        
     1232       CHARACTER (LEN = *), INTENT(IN) ::  sk_char !< string identifier, used for assign fluxes to the
     1233                                                   !<correct dimension in the analysis array
     1234
    12291235       INTEGER(iwp) ::  i         !< grid index along x-direction
    12301236       INTEGER(iwp) ::  i_omp     !< leftmost index on subdomain, or in case of OpenMP, on thread
     
    12351241       INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
    12361242       INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
    1237        INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms 
     1243       INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
    12381244       INTEGER(iwp) ::  tn        !< number of OpenMP thread
    1239        
     1245
    12401246       INTEGER(iwp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::   &
    12411247                                                  advc_flag !< flag array to control order of scalar advection
     
    12441250       LOGICAL           ::  non_cyclic_n    !< flag that indicates non-cyclic boundary on the north
    12451251       LOGICAL           ::  non_cyclic_r    !< flag that indicates non-cyclic boundary on the right
    1246        LOGICAL           ::  non_cyclic_s    !< flag that indicates non-cyclic boundary on the south                                           
     1252       LOGICAL           ::  non_cyclic_s    !< flag that indicates non-cyclic boundary on the south
    12471253       LOGICAL, OPTIONAL ::  flux_limitation !< flag indicating flux limitation of the vertical advection
    12481254       LOGICAL           ::  limiter         !< control flag indicating the application of flux limitation
     
    12511257       REAL(wp) ::  div           !< velocity diverence on scalar grid
    12521258       REAL(wp) ::  div_in        !< vertical flux divergence of ingoing fluxes
    1253        REAL(wp) ::  div_out       !< vertical flux divergence of outgoing fluxes     
     1259       REAL(wp) ::  div_out       !< vertical flux divergence of outgoing fluxes
    12541260       REAL(wp) ::  f_corr_t      !< correction flux at grid-cell top, i.e. the difference between high and low-order flux
    12551261       REAL(wp) ::  f_corr_d      !< correction flux at grid-cell bottom, i.e. the difference between high and low-order flux
     
    12721278       REAL(wp) ::  min_val       !< maximum value of the quanitity along the numerical stencil (in vertical direction)
    12731279       REAL(wp) ::  mon           !< monotone solution of the advection equation using 1st-order fluxes
    1274        REAL(wp) ::  u_comp        !< advection velocity along x-direction 
    1275        REAL(wp) ::  v_comp        !< advection velocity along y-direction 
    1276 !       
    1277 !--    sk is an array from parameter list. It should not be a pointer, because 
    1278 !--    in that case the compiler can not assume a stride 1 and cannot perform 
    1279 !--    a strided one vector load. Adding the CONTIGUOUS keyword makes things 
    1280 !--    even worse, because the compiler cannot assume strided one in the 
     1280       REAL(wp) ::  u_comp        !< advection velocity along x-direction
     1281       REAL(wp) ::  v_comp        !< advection velocity along y-direction
     1282!
     1283!--    sk is an array from parameter list. It should not be a pointer, because
     1284!--    in that case the compiler can not assume a stride 1 and cannot perform
     1285!--    a strided one vector load. Adding the CONTIGUOUS keyword makes things
     1286!--    even worse, because the compiler cannot assume strided one in the
    12811287!--    caller side.
    12821288       REAL(wp), INTENT(IN),DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<  advected scalar
    12831289
    1284        REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_n     !< discretized artificial dissipation at northward-side of the grid box
    1285        REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_r     !< discretized artificial dissipation at rightward-side of the grid box
    1286        REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_t     !< discretized artificial dissipation at top of the grid box
    1287        REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_n     !< discretized 6th-order flux at northward-side of the grid box
    1288        REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_r     !< discretized 6th-order flux at rightward-side of the grid box
    1289        REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_t     !< discretized 6th-order flux at top of the grid box
    1290        REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_t_1st !< discretized 1st-order flux at top of the grid box
    1291        
    1292        REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_diss_y_local !< discretized artificial dissipation at southward-side of the grid box
    1293        REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_flux_y_local !< discretized 6th-order flux at northward-side of the grid box
    1294        
    1295        REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_diss_x_local !< discretized artificial dissipation at leftward-side of the grid box
    1296        REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_flux_x_local !< discretized 6th-order flux at leftward-side of the grid box
    1297 !
    1298 !--    Used local modified copy of nzb_max (used to degrade order of
     1290       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_n     !< discretized artificial dissipation at northward-side
     1291       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_r     !< discretized artificial dissipation at rightward-side
     1292       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_t     !< discretized artificial dissipation at top
     1293       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_n     !< discretized 6th-order flux at northward-side
     1294       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_r     !< discretized 6th-order flux at rightward-side
     1295       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_t     !< discretized 6th-order flux at top
     1296       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_t_1st !< discretized 1st-order flux at top
     1297
     1298       REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_diss_y_local !< discretized artificial dissipation at southward-side
     1299       REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_flux_y_local !< discretized 6th-order flux at northward-side
     1300       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_diss_x_local !< discretized artificial dissipation at leftward-side
     1301       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_flux_x_local !< discretized 6th-order flux at leftward-side
     1302!
     1303!--    Used local modified copy of nzb_max (used to degrade order of
    12991304!--    discretization) at non-cyclic boundaries. Modify only at relevant points
    1300 !--    instead of the entire subdomain. This should lead to better 
     1305!--    instead of the entire subdomain. This should lead to better
    13011306!--    load balance between boundary and non-boundary PEs.
    13021307       IF( non_cyclic_l  .AND.  i <= nxl + 2  .OR.                             &
     
    13091314       END IF
    13101315!
    1311 !--    Set control flag for flux limiter 
     1316!--    Set control flag for flux limiter
    13121317       limiter = .FALSE.
    13131318       IF ( PRESENT( flux_limitation) )  limiter = flux_limitation
     
    13241329
    13251330             v_comp                  = v(k,j,i) - v_gtrans + v_stokes_zu(k)
    1326              swap_flux_y_local(k,tn) = v_comp *         (                     &
    1327                                                ( 37.0_wp * ibit5 * adv_sca_5  &
    1328                                             +     7.0_wp * ibit4 * adv_sca_3  &
    1329                                             +              ibit3 * adv_sca_1  &
    1330                                                ) *                            &
    1331                                            ( sk(k,j,i)  + sk(k,j-1,i)     )   &
    1332                                          -     (  8.0_wp * ibit5 * adv_sca_5  &
    1333                                             +              ibit4 * adv_sca_3  &
    1334                                                 ) *                           &
    1335                                            ( sk(k,j+1,i) + sk(k,j-2,i)    )   &
    1336                                          +     (           ibit5 * adv_sca_5  &
    1337                                                ) *                            &
    1338                                            ( sk(k,j+2,i) + sk(k,j-3,i)    )   &
     1331             swap_flux_y_local(k,tn) = v_comp *         (                      &
     1332                                               ( 37.0_wp * ibit5 * adv_sca_5   &
     1333                                            +     7.0_wp * ibit4 * adv_sca_3   &
     1334                                            +              ibit3 * adv_sca_1   &
     1335                                               ) *                             &
     1336                                           ( sk(k,j,i)  + sk(k,j-1,i)     )    &
     1337                                         -     (  8.0_wp * ibit5 * adv_sca_5   &
     1338                                            +              ibit4 * adv_sca_3   &
     1339                                                ) *                            &
     1340                                           ( sk(k,j+1,i) + sk(k,j-2,i)    )    &
     1341                                         +     (           ibit5 * adv_sca_5   &
     1342                                               ) *                             &
     1343                                           ( sk(k,j+2,i) + sk(k,j-3,i)    )    &
    13391344                                                        )
    13401345
    1341              swap_diss_y_local(k,tn) = -ABS( v_comp ) * (                     &
    1342                                                ( 10.0_wp * ibit5 * adv_sca_5  &
    1343                                             +     3.0_wp * ibit4 * adv_sca_3  &
    1344                                             +              ibit3 * adv_sca_1  &
    1345                                                ) *                            &
    1346                                             ( sk(k,j,i)   - sk(k,j-1,i)  )    &
    1347                                         -      (  5.0_wp * ibit5 * adv_sca_5  &
    1348                                             +              ibit4 * adv_sca_3  &
    1349                                             ) *                               &
    1350                                             ( sk(k,j+1,i) - sk(k,j-2,i)  )    &
    1351                                         +      (           ibit5 * adv_sca_5  &
    1352                                                ) *                            &
    1353                                             ( sk(k,j+2,i) - sk(k,j-3,i)  )    &
     1346             swap_diss_y_local(k,tn) = -ABS( v_comp ) * (                      &
     1347                                               ( 10.0_wp * ibit5 * adv_sca_5   &
     1348                                            +     3.0_wp * ibit4 * adv_sca_3   &
     1349                                            +              ibit3 * adv_sca_1   &
     1350                                               ) *                             &
     1351                                            ( sk(k,j,i)   - sk(k,j-1,i)  )     &
     1352                                        -      (  5.0_wp * ibit5 * adv_sca_5   &
     1353                                            +              ibit4 * adv_sca_3   &
     1354                                            ) *                                &
     1355                                            ( sk(k,j+1,i) - sk(k,j-2,i)  )     &
     1356                                        +      (           ibit5 * adv_sca_5   &
     1357                                               ) *                             &
     1358                                            ( sk(k,j+2,i) - sk(k,j-3,i)  )     &
    13541359                                                        )
    13551360
     
    13601365
    13611366             v_comp                  = v(k,j,i) - v_gtrans + v_stokes_zu(k)
    1362              swap_flux_y_local(k,tn) = v_comp * (                             &
    1363                                     37.0_wp * ( sk(k,j,i)   + sk(k,j-1,i) )   &
    1364                                   -  8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) )   &
    1365                                   +           ( sk(k,j+2,i) + sk(k,j-3,i) )   &
     1367             swap_flux_y_local(k,tn) = v_comp * (                              &
     1368                                    37.0_wp * ( sk(k,j,i)   + sk(k,j-1,i) )    &
     1369                                  -  8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) )    &
     1370                                  +           ( sk(k,j+2,i) + sk(k,j-3,i) )    &
    13661371                                                ) * adv_sca_5
    1367              swap_diss_y_local(k,tn) = -ABS( v_comp ) * (                     &
    1368                                     10.0_wp * ( sk(k,j,i)   - sk(k,j-1,i) )   &
    1369                                   -  5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) )   &
    1370                                   +             sk(k,j+2,i) - sk(k,j-3,i)     &
     1372             swap_diss_y_local(k,tn) = -ABS( v_comp ) * (                      &
     1373                                    10.0_wp * ( sk(k,j,i)   - sk(k,j-1,i) )    &
     1374                                  -  5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) )    &
     1375                                  +             sk(k,j+2,i) - sk(k,j-3,i)      &
    13711376                                                        ) * adv_sca_5
    13721377
     
    13771382!--    Compute leftside fluxes of the respective PE bounds.
    13781383       IF ( i == i_omp )  THEN
    1379        
     1384
    13801385          DO  k = nzb+1, nzb_max_l
    13811386
     
    13841389             ibit0 = REAL( IBITS(advc_flag(k,j,i-1),0,1), KIND = wp )
    13851390
    1386              u_comp                     = u(k,j,i) - u_gtrans + u_stokes_zu(k)
    1387              swap_flux_x_local(k,j,tn) = u_comp * (                           &
    1388                                                ( 37.0_wp * ibit2 * adv_sca_5  &
    1389                                             +     7.0_wp * ibit1 * adv_sca_3  &
    1390                                             +              ibit0 * adv_sca_1  &
    1391                                                ) *                            &
    1392                                             ( sk(k,j,i)   + sk(k,j,i-1)    )  &
    1393                                         -      (  8.0_wp * ibit2 * adv_sca_5  &
    1394                                             +              ibit1 * adv_sca_3  &
    1395                                                ) *                            &
    1396                                             ( sk(k,j,i+1) + sk(k,j,i-2)    )  &
    1397                                         +      (           ibit2 * adv_sca_5  &
    1398                                                ) *                            &
    1399                                             ( sk(k,j,i+2) + sk(k,j,i-3)    )  &
     1391             u_comp                    = u(k,j,i) - u_gtrans + u_stokes_zu(k)
     1392             swap_flux_x_local(k,j,tn) = u_comp * (                            &
     1393                                               ( 37.0_wp * ibit2 * adv_sca_5   &
     1394                                            +     7.0_wp * ibit1 * adv_sca_3   &
     1395                                            +              ibit0 * adv_sca_1   &
     1396                                               ) *                             &
     1397                                            ( sk(k,j,i)   + sk(k,j,i-1)    )   &
     1398                                        -      (  8.0_wp * ibit2 * adv_sca_5   &
     1399                                            +              ibit1 * adv_sca_3   &
     1400                                               ) *                             &
     1401                                            ( sk(k,j,i+1) + sk(k,j,i-2)    )   &
     1402                                        +      (           ibit2 * adv_sca_5   &
     1403                                               ) *                             &
     1404                                            ( sk(k,j,i+2) + sk(k,j,i-3)    )   &
    14001405                                                  )
    14011406
    1402              swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * (                   &
    1403                                                ( 10.0_wp * ibit2 * adv_sca_5  &
    1404                                             +     3.0_wp * ibit1 * adv_sca_3  &
    1405                                             +              ibit0 * adv_sca_1  &
    1406                                                ) *                            &
    1407                                             ( sk(k,j,i)   - sk(k,j,i-1)    )  &
    1408                                         -      (  5.0_wp * ibit2 * adv_sca_5  &
    1409                                             +              ibit1 * adv_sca_3  &
    1410                                                ) *                            &
    1411                                             ( sk(k,j,i+1) - sk(k,j,i-2)    )  &
    1412                                         +      (           ibit2 * adv_sca_5  &
    1413                                                ) *                            &
    1414                                             ( sk(k,j,i+2) - sk(k,j,i-3)    )  &
     1407             swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * (                    &
     1408                                               ( 10.0_wp * ibit2 * adv_sca_5   &
     1409                                            +     3.0_wp * ibit1 * adv_sca_3   &
     1410                                            +              ibit0 * adv_sca_1   &
     1411                                               ) *                             &
     1412                                            ( sk(k,j,i)   - sk(k,j,i-1)    )   &
     1413                                        -      (  5.0_wp * ibit2 * adv_sca_5   &
     1414                                            +              ibit1 * adv_sca_3   &
     1415                                               ) *                             &
     1416                                            ( sk(k,j,i+1) - sk(k,j,i-2)    )   &
     1417                                        +      (           ibit2 * adv_sca_5   &
     1418                                               ) *                             &
     1419                                            ( sk(k,j,i+2) - sk(k,j,i-3)    )   &
    14151420                                                          )
    14161421
     
    14191424          DO  k = nzb_max_l+1, nzt
    14201425
    1421              u_comp                 = u(k,j,i) - u_gtrans + u_stokes_zu(k)
    1422              swap_flux_x_local(k,j,tn) = u_comp * (                           &
    1423                                       37.0_wp * ( sk(k,j,i)   + sk(k,j,i-1) ) &
    1424                                     -  8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) ) &
    1425                                     +           ( sk(k,j,i+2) + sk(k,j,i-3) ) &
     1426             u_comp                    = u(k,j,i) - u_gtrans + u_stokes_zu(k)
     1427             swap_flux_x_local(k,j,tn) = u_comp * (                            &
     1428                                      37.0_wp * ( sk(k,j,i)   + sk(k,j,i-1) )  &
     1429                                    -  8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) )  &
     1430                                    +           ( sk(k,j,i+2) + sk(k,j,i-3) )  &
    14261431                                                  ) * adv_sca_5
    14271432
    1428              swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * (                   &
    1429                                       10.0_wp * ( sk(k,j,i)   - sk(k,j,i-1) ) &
    1430                                     -  5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) ) &
    1431                                     +           ( sk(k,j,i+2) - sk(k,j,i-3) ) &
     1433             swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * (                    &
     1434                                      10.0_wp * ( sk(k,j,i)   - sk(k,j,i-1) )  &
     1435                                    -  5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) )  &
     1436                                    +           ( sk(k,j,i+2) - sk(k,j,i-3) )  &
    14321437                                                          ) * adv_sca_5
    14331438
    14341439          ENDDO
    1435            
     1440
    14361441       ENDIF
    1437 !       
    1438 !--    Now compute the fluxes and tendency terms for the horizontal and
    1439 !--    vertical parts up to the top of the highest topography.
     1442!
     1443!--    Now compute the fluxes for the horizontal termns up to the highest
     1444!--    topography.
    14401445       DO  k = nzb+1, nzb_max_l
    1441 !
    1442 !--       Note: It is faster to conduct all multiplications explicitly, e.g.
    1443 !--       * adv_sca_5 ... than to determine a factor and multiplicate the
    1444 !--       flux at the end.
    14451446
    14461447          ibit2 = REAL( IBITS(advc_flag(k,j,i),2,1), KIND = wp )
     
    14491450
    14501451          u_comp    = u(k,j,i+1) - u_gtrans + u_stokes_zu(k)
    1451           flux_r(k) = u_comp * (                                              &
    1452                      ( 37.0_wp * ibit2 * adv_sca_5                            &
    1453                   +     7.0_wp * ibit1 * adv_sca_3                            &
    1454                   +              ibit0 * adv_sca_1                            &
    1455                      ) *                                                      &
    1456                              ( sk(k,j,i+1) + sk(k,j,i)   )                    &
    1457               -      (  8.0_wp * ibit2 * adv_sca_5                            &
    1458                   +              ibit1 * adv_sca_3                            &
    1459                      ) *                                                      &
    1460                              ( sk(k,j,i+2) + sk(k,j,i-1) )                    &
    1461               +      (           ibit2 * adv_sca_5                            &
    1462                      ) *                                                      &
    1463                              ( sk(k,j,i+3) + sk(k,j,i-2) )                    &
     1452          flux_r(k) = u_comp * (                                               &
     1453                     ( 37.0_wp * ibit2 * adv_sca_5                             &
     1454                  +     7.0_wp * ibit1 * adv_sca_3                             &
     1455                  +              ibit0 * adv_sca_1                             &
     1456                     ) *                                                       &
     1457                             ( sk(k,j,i+1) + sk(k,j,i)   )                     &
     1458              -      (  8.0_wp * ibit2 * adv_sca_5                             &
     1459                  +              ibit1 * adv_sca_3                             &
     1460                     ) *                                                       &
     1461                             ( sk(k,j,i+2) + sk(k,j,i-1) )                     &
     1462              +      (           ibit2 * adv_sca_5                             &
     1463                     ) *                                                       &
     1464                             ( sk(k,j,i+3) + sk(k,j,i-2) )                     &
    14641465                               )
    14651466
    1466           diss_r(k) = -ABS( u_comp ) * (                                      &
    1467                      ( 10.0_wp * ibit2 * adv_sca_5                            &
    1468                   +     3.0_wp * ibit1 * adv_sca_3                            &
    1469                   +              ibit0 * adv_sca_1                            &
    1470                      ) *                                                      &
    1471                              ( sk(k,j,i+1) - sk(k,j,i)  )                     &
    1472               -      (  5.0_wp * ibit2 * adv_sca_5                            &
    1473                   +              ibit1 * adv_sca_3                            &
    1474                      ) *                                                      &
    1475                              ( sk(k,j,i+2) - sk(k,j,i-1) )                    &
    1476               +      (           ibit2 * adv_sca_5                            &
    1477                      ) *                                                      &
    1478                              ( sk(k,j,i+3) - sk(k,j,i-2) )                    &
     1467          diss_r(k) = -ABS( u_comp ) * (                                       &
     1468                     ( 10.0_wp * ibit2 * adv_sca_5                             &
     1469                  +     3.0_wp * ibit1 * adv_sca_3                             &
     1470                  +              ibit0 * adv_sca_1                             &
     1471                     ) *                                                       &
     1472                             ( sk(k,j,i+1) - sk(k,j,i)  )                      &
     1473              -      (  5.0_wp * ibit2 * adv_sca_5                             &
     1474                  +              ibit1 * adv_sca_3                             &
     1475                     ) *                                                       &
     1476                             ( sk(k,j,i+2) - sk(k,j,i-1) )                     &
     1477              +      (           ibit2 * adv_sca_5                             &
     1478                     ) *                                                       &
     1479                             ( sk(k,j,i+3) - sk(k,j,i-2) )                     &
    14791480                                       )
    14801481
     
    15151516       ENDDO
    15161517!
    1517 !--    Now compute the fluxes and tendency terms for the horizontal and
    1518 !--    vertical parts above the top of the highest topography. No degradation
    1519 !--    for the horizontal parts, but for the vertical it is stell needed.
     1518!--    Now compute the fluxes for the horizontal terms above the topography
     1519!--    where no degradation along the horizontal parts is necessary (except
     1520!--    for the non-cyclic lateral boundaries treated by nzb_max_l).
    15201521       DO  k = nzb_max_l+1, nzt
    15211522
     
    15421543       ENDDO
    15431544!
    1544 !--    Now, compute vertical fluxes. Split loop into a part treating the 
     1545!--    Now, compute vertical fluxes. Split loop into a part treating the
    15451546!--    lowest grid points with indirect indexing, a main loop without
    15461547!--    indirect indexing, and a loop for the uppermost grip points with
    15471548!--    indirect indexing. This allows better vectorization for the main loop.
    1548 !--    First, compute the flux at model surface, which need has to be 
     1549!--    First, compute the flux at model surface, which need has to be
    15491550!--    calculated explicetely for the tendency at
    15501551!--    the first w-level. For topography wall this is done implicitely by
     
    15521553       flux_t(nzb) = 0.0_wp
    15531554       diss_t(nzb) = 0.0_wp
    1554        
     1555
    15551556       DO  k = nzb+1, nzb+1
    15561557          ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
     
    15631564          k_pp  = k + 2 * ( 1 - ibit6  )
    15641565          k_mm  = k - 2 * ibit8
    1565 
    1566 
    1567           flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                            &
    1568                      ( 37.0_wp * ibit8 * adv_sca_5                            &
    1569                   +     7.0_wp * ibit7 * adv_sca_3                            &
    1570                   +              ibit6 * adv_sca_1                            &
    1571                      ) *                                                      &
    1572                              ( sk(k+1,j,i)  + sk(k,j,i)    )                  &
    1573               -      (  8.0_wp * ibit8 * adv_sca_5                            &
    1574                   +              ibit7 * adv_sca_3                            &
    1575                      ) *                                                      &
    1576                              ( sk(k_pp,j,i) + sk(k-1,j,i)  )                  &
    1577               +      (           ibit8 * adv_sca_5                            &
    1578                      ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )                  &
    1579                                  )
    1580 
    1581           diss_t(k) = -ABS( w(k,j,i) ) * rho_air_zw(k) * (                    &
    1582                      ( 10.0_wp * ibit8 * adv_sca_5                            &
    1583                   +     3.0_wp * ibit7 * adv_sca_3                            &
    1584                   +              ibit6 * adv_sca_1                            &
    1585                      ) *                                                      &
    1586                              ( sk(k+1,j,i)   - sk(k,j,i)    )                 &
    1587               -      (  5.0_wp * ibit8 * adv_sca_5                            &
    1588                   +              ibit7 * adv_sca_3                            &
    1589                      ) *                                                      &
    1590                              ( sk(k_pp,j,i)  - sk(k-1,j,i)  )                 &
    1591               +      (           ibit8 * adv_sca_5                            &
    1592                      ) *                                                      &
    1593                              ( sk(k_ppp,j,i) - sk(k_mm,j,i) )                 &
    1594                                          )
    1595        ENDDO
    1596        
    1597        DO  k = nzb+2, nzt-2
    1598           ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
    1599           ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
    1600           ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
    1601 
    1602           flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                            &
    1603                      ( 37.0_wp * ibit8 * adv_sca_5                            &
    1604                   +     7.0_wp * ibit7 * adv_sca_3                            &
    1605                   +              ibit6 * adv_sca_1                            &
    1606                      ) *                                                      &
    1607                              ( sk(k+1,j,i)  + sk(k,j,i)    )                  &
    1608               -      (  8.0_wp * ibit8 * adv_sca_5                            &
    1609                   +              ibit7 * adv_sca_3                            &
    1610                      ) *                                                      &
    1611                              ( sk(k+2,j,i) + sk(k-1,j,i)  )                   &
    1612               +      (           ibit8 * adv_sca_5                            &
    1613                      ) *     ( sk(k+3,j,i)+ sk(k-2,j,i) )                     &
    1614                                                  )
    1615 
    1616           diss_t(k) = -ABS( w(k,j,i) ) * rho_air_zw(k) * (                    &
    1617                      ( 10.0_wp * ibit8 * adv_sca_5                            &
    1618                   +     3.0_wp * ibit7 * adv_sca_3                            &
    1619                   +              ibit6 * adv_sca_1                            &
    1620                      ) *                                                      &
    1621                              ( sk(k+1,j,i)   - sk(k,j,i)    )                 &
    1622               -      (  5.0_wp * ibit8 * adv_sca_5                            &
    1623                   +              ibit7 * adv_sca_3                            &
    1624                      ) *                                                      &
    1625                              ( sk(k+2,j,i)  - sk(k-1,j,i)  )                  &
    1626               +      (           ibit8 * adv_sca_5                            &
    1627                      ) *                                                      &
    1628                              ( sk(k+3,j,i) - sk(k-2,j,i) )                    &
    1629                                                          )
    1630        ENDDO       
    1631        
    1632        DO  k = nzt-1, nzt-symmetry_flag
    1633           ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
    1634           ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
    1635           ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
    1636 !
    1637 !--       k index has to be modified near bottom and top, else array
    1638 !--       subscripts will be exceeded.
    1639           k_ppp = k + 3 * ibit8
    1640           k_pp  = k + 2 * ( 1 - ibit6  )
    1641           k_mm  = k - 2 * ibit8
    1642 
    16431566
    16441567          flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                            &
     
    16711594                                                         )
    16721595       ENDDO
    1673        
     1596
     1597       DO  k = nzb+2, nzt-2
     1598          ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
     1599          ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
     1600          ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
     1601
     1602          flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                            &
     1603                     ( 37.0_wp * ibit8 * adv_sca_5                            &
     1604                  +     7.0_wp * ibit7 * adv_sca_3                            &
     1605                  +              ibit6 * adv_sca_1                            &
     1606                     ) *                                                      &
     1607                             ( sk(k+1,j,i)  + sk(k,j,i)    )                  &
     1608              -      (  8.0_wp * ibit8 * adv_sca_5                            &
     1609                  +              ibit7 * adv_sca_3                            &
     1610                     ) *                                                      &
     1611                             ( sk(k+2,j,i) + sk(k-1,j,i)  )                   &
     1612              +      (           ibit8 * adv_sca_5                            &
     1613                     ) *     ( sk(k+3,j,i)+ sk(k-2,j,i) )                     &
     1614                                                 )
     1615
     1616          diss_t(k) = -ABS( w(k,j,i) ) * rho_air_zw(k) * (                    &
     1617                     ( 10.0_wp * ibit8 * adv_sca_5                            &
     1618                  +     3.0_wp * ibit7 * adv_sca_3                            &
     1619                  +              ibit6 * adv_sca_1                            &
     1620                     ) *                                                      &
     1621                             ( sk(k+1,j,i)   - sk(k,j,i)    )                 &
     1622              -      (  5.0_wp * ibit8 * adv_sca_5                            &
     1623                  +              ibit7 * adv_sca_3                            &
     1624                     ) *                                                      &
     1625                             ( sk(k+2,j,i)  - sk(k-1,j,i)  )                  &
     1626              +      (           ibit8 * adv_sca_5                            &
     1627                     ) *                                                      &
     1628                             ( sk(k+3,j,i) - sk(k-2,j,i) )                    &
     1629                                                         )
     1630       ENDDO
     1631
     1632       DO  k = nzt-1, nzt-symmetry_flag
     1633          ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
     1634          ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
     1635          ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
     1636!
     1637!--       k index has to be modified near bottom and top, else array
     1638!--       subscripts will be exceeded.
     1639          k_ppp = k + 3 * ibit8
     1640          k_pp  = k + 2 * ( 1 - ibit6  )
     1641          k_mm  = k - 2 * ibit8
     1642
     1643
     1644          flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                            &
     1645                     ( 37.0_wp * ibit8 * adv_sca_5                            &
     1646                  +     7.0_wp * ibit7 * adv_sca_3                            &
     1647                  +              ibit6 * adv_sca_1                            &
     1648                     ) *                                                      &
     1649                             ( sk(k+1,j,i)  + sk(k,j,i)    )                  &
     1650              -      (  8.0_wp * ibit8 * adv_sca_5                            &
     1651                  +              ibit7 * adv_sca_3                            &
     1652                     ) *                                                      &
     1653                             ( sk(k_pp,j,i) + sk(k-1,j,i)  )                  &
     1654              +      (           ibit8 * adv_sca_5                            &
     1655                     ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )                  &
     1656                                                 )
     1657
     1658          diss_t(k) = -ABS( w(k,j,i) ) * rho_air_zw(k) * (                    &
     1659                     ( 10.0_wp * ibit8 * adv_sca_5                            &
     1660                  +     3.0_wp * ibit7 * adv_sca_3                            &
     1661                  +              ibit6 * adv_sca_1                            &
     1662                     ) *                                                      &
     1663                             ( sk(k+1,j,i)   - sk(k,j,i)    )                 &
     1664              -      (  5.0_wp * ibit8 * adv_sca_5                            &
     1665                  +              ibit7 * adv_sca_3                            &
     1666                     ) *                                                      &
     1667                             ( sk(k_pp,j,i)  - sk(k-1,j,i)  )                 &
     1668              +      (           ibit8 * adv_sca_5                            &
     1669                     ) *                                                      &
     1670                             ( sk(k_ppp,j,i) - sk(k_mm,j,i) )                 &
     1671                                                         )
     1672       ENDDO
     1673
    16741674!
    16751675!--    Set resolved/turbulent flux at model top to zero (w-level). In case that
    16761676!--    a symmetric behavior between bottom and top shall be guaranteed (closed
    1677 !--    channel flow), the flux at nzt is also set to zero. 
     1677!--    channel flow), the flux at nzt is also set to zero.
    16781678       IF ( symmetry_flag == 1 ) THEN
    16791679          flux_t(nzt) = 0.0_wp
     
    16821682       flux_t(nzt+1) = 0.0_wp
    16831683       diss_t(nzt+1) = 0.0_wp
    1684        
    1685        
     1684
     1685
    16861686       IF ( limiter )  THEN
    16871687!
     
    16951695!
    16961696!--          In flux limitation the total flux will be corrected. For the sake
    1697 !--          of cleariness the higher-order advective and disspative fluxes 
    1698 !--          will be merged onto flux_t. 
     1697!--          of cleariness the higher-order advective and disspative fluxes
     1698!--          will be merged onto flux_t.
    16991699             flux_t(k) = flux_t(k) + diss_t(k)
    17001700             diss_t(k) = 0.0_wp
    17011701          ENDDO
    17021702!
    1703 !--       Flux limitation of vertical fluxes according to Skamarock (2006). 
     1703!--       Flux limitation of vertical fluxes according to Skamarock (2006).
    17041704!--       Please note, as flux limitation implies linear dependencies of fluxes,
    17051705!--       flux limitation is only made for the vertical advection term. Limitation
    1706 !--       of the horizontal terms cannot be parallelized. 
     1706!--       of the horizontal terms cannot be parallelized.
    17071707!--       Due to the linear dependency, the following loop will not be vectorized.
    17081708!--       Further, note that the flux limiter is only applied within the urban
    1709 !--       layer, i.e up to the topography top. 
     1709!--       layer, i.e up to the topography top.
    17101710          DO  k = nzb+1, nzb_max_l
    17111711!
    17121712!--          Compute one-dimensional divergence along the vertical direction,
    1713 !--          which is used to correct the advection discretization. This is 
     1713!--          which is used to correct the advection discretization. This is
    17141714!--          necessary as in one-dimensional space the advection velocity
    1715 !--          should actually be constant. 
     1715!--          should actually be constant.
    17161716             div = ( w(k,j,i)   * rho_air_zw(k)                                &
    1717                    - w(k-1,j,i) * rho_air_zw(k-1)                              &     
     1717                   - w(k-1,j,i) * rho_air_zw(k-1)                              &
    17181718                   ) * drho_air(k) * ddzw(k)
    17191719!
    1720 !--          Compute monotone solution of the advection equation from 
     1720!--          Compute monotone solution of the advection equation from
    17211721!--          1st-order fluxes. Please note, the advection equation is corrected
    17221722!--          by the divergence term (in 1D the advective flow should be divergence
    1723 !--          free). Moreover, please note, as time-increment the full timestep 
    1724 !--          is used, even though a Runge-Kutta scheme will be used. However, 
    1725 !--          the length of the actual time increment is not important at all 
    1726 !--          since it cancels out later when the fluxes are limited.   
     1723!--          free). Moreover, please note, as time-increment the full timestep
     1724!--          is used, even though a Runge-Kutta scheme will be used. However,
     1725!--          the length of the actual time increment is not important at all
     1726!--          since it cancels out later when the fluxes are limited.
    17271727             mon = sk(k,j,i) + ( - ( flux_t_1st(k) - flux_t_1st(k-1) )         &
    17281728                             * drho_air(k) * ddzw(k)                           &
    17291729                             + div * sk(k,j,i)                                 &
    1730                                ) * dt_3d 
     1730                               ) * dt_3d
    17311731!
    17321732!--          Determine minimum and maximum values along the numerical stencil.
    17331733             k_mmm = MAX( k - 3, nzb + 1 )
    1734              k_ppp = MIN( k + 3, nzt + 1 ) 
     1734             k_ppp = MIN( k + 3, nzt + 1 )
    17351735
    17361736             min_val = MINVAL( sk(k_mmm:k_ppp,j,i) )
    17371737             max_val = MAXVAL( sk(k_mmm:k_ppp,j,i) )
    17381738!
    1739 !--          Compute difference between high- and low-order fluxes, which may 
     1739!--          Compute difference between high- and low-order fluxes, which may
    17401740!--          act as correction fluxes
    17411741             f_corr_t = flux_t(k)   - flux_t_1st(k)
    17421742             f_corr_d = flux_t(k-1) - flux_t_1st(k-1)
    17431743!
    1744 !--          Determine outgoing fluxes, i.e. the part of the fluxes which can 
     1744!--          Determine outgoing fluxes, i.e. the part of the fluxes which can
    17451745!--          decrease the value within the grid box
    17461746             f_corr_t_out = MAX( 0.0_wp, f_corr_t )
    17471747             f_corr_d_out = MIN( 0.0_wp, f_corr_d )
    17481748!
    1749 !--          Determine ingoing fluxes, i.e. the part of the fluxes which can 
    1750 !--          increase the value within the grid box 
     1749!--          Determine ingoing fluxes, i.e. the part of the fluxes which can
     1750!--          increase the value within the grid box
    17511751             f_corr_t_in = MIN( 0.0_wp, f_corr_t)
    17521752             f_corr_d_in = MAX( 0.0_wp, f_corr_d)
     
    17621762!--          Check if outgoing fluxes can lead to undershoots, i.e. values smaller
    17631763!--          than the minimum value within the numerical stencil. If so, limit
    1764 !--          them. 
     1764!--          them.
    17651765             IF ( mon - min_val < - div_out  .AND.  ABS( div_out ) > 0.0_wp )  &
    17661766             THEN
     
    17721772!--          Check if ingoing fluxes can lead to overshoots, i.e. values larger
    17731773!--          than the maximum value within the numerical stencil. If so, limit
    1774 !--          them. 
     1774!--          them.
    17751775             IF ( mon - max_val > - div_in  .AND.  ABS( div_in ) > 0.0_wp )    &
    17761776             THEN
     
    17801780             ENDIF
    17811781!
    1782 !--          Finally add the limited fluxes to the original ones. If no 
    1783 !--          flux limitation was done, the fluxes equal the original ones. 
     1782!--          Finally add the limited fluxes to the original ones. If no
     1783!--          flux limitation was done, the fluxes equal the original ones.
    17841784             flux_t(k)   = flux_t_1st(k)   + f_corr_t_out + f_corr_t_in
    17851785             flux_t(k-1) = flux_t_1st(k-1) + f_corr_d_out + f_corr_d_in
    17861786          ENDDO
    17871787       ENDIF
    1788 
     1788!
     1789!--    Now compute the tendency term including divergence correction.
    17891790       DO  k = nzb+1, nzb_max_l
    17901791
    17911792          flux_d    = flux_t(k-1)
    17921793          diss_d    = diss_t(k-1)
    1793          
     1794
    17941795          ibit2 = REAL( IBITS(advc_flag(k,j,i),2,1), KIND = wp )
    17951796          ibit1 = REAL( IBITS(advc_flag(k,j,i),1,1), KIND = wp )
    17961797          ibit0 = REAL( IBITS(advc_flag(k,j,i),0,1), KIND = wp )
    1797          
     1798
    17981799          ibit5 = REAL( IBITS(advc_flag(k,j,i),5,1), KIND = wp )
    17991800          ibit4 = REAL( IBITS(advc_flag(k,j,i),4,1), KIND = wp )
    18001801          ibit3 = REAL( IBITS(advc_flag(k,j,i),3,1), KIND = wp )
    1801          
     1802
    18021803          ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
    18031804          ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
     
    18071808!--       correction is needed to overcome numerical instabilities introduced
    18081809!--       by a not sufficient reduction of divergences near topography.
    1809           div         =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )            &
    1810                           - u(k,j,i)   * (                                    &
    1811                         REAL( IBITS(advc_flag(k,j,i-1),0,1), KIND = wp )      &
    1812                       + REAL( IBITS(advc_flag(k,j,i-1),1,1), KIND = wp )      &
    1813                       + REAL( IBITS(advc_flag(k,j,i-1),2,1), KIND = wp )      &
    1814                                          )                                    &
    1815                           ) * ddx                                             &
    1816                         + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )            &
    1817                           - v(k,j,i)   * (                                    &
    1818                         REAL( IBITS(advc_flag(k,j-1,i),3,1), KIND = wp )      &
    1819                       + REAL( IBITS(advc_flag(k,j-1,i),4,1), KIND = wp )      &
    1820                       + REAL( IBITS(advc_flag(k,j-1,i),5,1), KIND = wp )      &
    1821                                          )                                    &
    1822                           ) * ddy                                             &
    1823                         + ( w(k,j,i) * rho_air_zw(k) *                        &
    1824                                          ( ibit6 + ibit7 + ibit8 )            &
    1825                           - w(k-1,j,i) * rho_air_zw(k-1) *                    &
    1826                                          (                                    &
    1827                         REAL( IBITS(advc_flag(k-1,j,i),6,1), KIND = wp )      &
    1828                       + REAL( IBITS(advc_flag(k-1,j,i),7,1), KIND = wp )      &
    1829                       + REAL( IBITS(advc_flag(k-1,j,i),8,1), KIND = wp )      &
    1830                                          )                                    &     
     1810          div         =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )             &
     1811                          - u(k,j,i)   * (                                     &
     1812                        REAL( IBITS(advc_flag(k,j,i-1),0,1), KIND = wp )       &
     1813                      + REAL( IBITS(advc_flag(k,j,i-1),1,1), KIND = wp )       &
     1814                      + REAL( IBITS(advc_flag(k,j,i-1),2,1), KIND = wp )       &
     1815                                         )                                     &
     1816                          ) * ddx                                              &
     1817                        + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )             &
     1818                          - v(k,j,i)   * (                                     &
     1819                        REAL( IBITS(advc_flag(k,j-1,i),3,1), KIND = wp )       &
     1820                      + REAL( IBITS(advc_flag(k,j-1,i),4,1), KIND = wp )       &
     1821                      + REAL( IBITS(advc_flag(k,j-1,i),5,1), KIND = wp )       &
     1822                                         )                                     &
     1823                          ) * ddy                                              &
     1824                        + ( w(k,j,i) * rho_air_zw(k) *                         &
     1825                                         ( ibit6 + ibit7 + ibit8 )             &
     1826                          - w(k-1,j,i) * rho_air_zw(k-1) *                     &
     1827                                         (                                     &
     1828                        REAL( IBITS(advc_flag(k-1,j,i),6,1), KIND = wp )       &
     1829                      + REAL( IBITS(advc_flag(k-1,j,i),7,1), KIND = wp )       &
     1830                      + REAL( IBITS(advc_flag(k-1,j,i),8,1), KIND = wp )       &
     1831                                         )                                     &
    18311832                          ) * drho_air(k) * ddzw(k)
    18321833
    1833           tend(k,j,i) = tend(k,j,i) - (                                       &
    1834                         ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j,tn) - &
    1835                           swap_diss_x_local(k,j,tn)            ) * ddx        &
    1836                       + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k,tn)   - &
    1837                           swap_diss_y_local(k,tn)              ) * ddy        &
    1838                       + ( ( flux_t(k) + diss_t(k) ) -                         &
    1839                           ( flux_d    + diss_d    )                           &
    1840                                                     ) * drho_air(k) * ddzw(k) &
     1834          tend(k,j,i) = tend(k,j,i) - (                                        &
     1835                        ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j,tn) -  &
     1836                          swap_diss_x_local(k,j,tn)            ) * ddx         &
     1837                      + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k,tn)   -  &
     1838                          swap_diss_y_local(k,tn)              ) * ddy         &
     1839                      + ( ( flux_t(k) + diss_t(k) ) -                          &
     1840                          ( flux_d    + diss_d    )                            &
     1841                                                    ) * drho_air(k) * ddzw(k)  &
    18411842                                      ) + sk(k,j,i) * div
    18421843
     
    18481849
    18491850       ENDDO
    1850        
     1851
    18511852       DO  k = nzb_max_l+1, nzt
    18521853
     
    18571858!--       correction is needed to overcome numerical instabilities introduced
    18581859!--       by a not sufficient reduction of divergences near topography.
    1859           div         =   ( u(k,j,i+1) - u(k,j,i) ) * ddx                     &
    1860                         + ( v(k,j+1,i) - v(k,j,i) ) * ddy                     &
    1861                         + ( w(k,j,i) * rho_air_zw(k)                          &
    1862                           - w(k-1,j,i) * rho_air_zw(k-1)                      &
     1860          div         =   ( u(k,j,i+1) - u(k,j,i) ) * ddx                      &
     1861                        + ( v(k,j+1,i) - v(k,j,i) ) * ddy                      &
     1862                        + ( w(k,j,i) * rho_air_zw(k)                           &
     1863                          - w(k-1,j,i) * rho_air_zw(k-1)                       &
    18631864                                                  ) * drho_air(k) * ddzw(k)
    18641865
    1865           tend(k,j,i) = tend(k,j,i) - (                                       &
    1866                         ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j,tn) - &
    1867                           swap_diss_x_local(k,j,tn)            ) * ddx        &
    1868                       + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k,tn)   - &
    1869                           swap_diss_y_local(k,tn)              ) * ddy        &
    1870                       + ( ( flux_t(k) + diss_t(k) ) -                         &
    1871                           ( flux_d    + diss_d    )                           &
    1872                                                     ) * drho_air(k) * ddzw(k) &
     1866          tend(k,j,i) = tend(k,j,i) - (                                        &
     1867                        ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j,tn) -  &
     1868                          swap_diss_x_local(k,j,tn)            ) * ddx         &
     1869                      + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k,tn)   -  &
     1870                          swap_diss_y_local(k,tn)              ) * ddy         &
     1871                      + ( ( flux_t(k) + diss_t(k) ) -                          &
     1872                          ( flux_d    + diss_d    )                            &
     1873                                                    ) * drho_air(k) * ddzw(k)  &
    18731874                                      ) + sk(k,j,i) * div
    18741875
     
    18951896                    ) * weight_substep(intermediate_timestep_count)
    18961897             ENDDO
    1897            
     1898
    18981899          CASE ( 'sa' )
    18991900
     
    19061907                    ) * weight_substep(intermediate_timestep_count)
    19071908             ENDDO
    1908            
     1909
    19091910          CASE ( 'q' )
    19101911
     
    19881989          !kk Has to be implemented for kpp chemistry
    19891990
    1990 
    19911991         END SELECT
    19921992
     
    20112011       INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
    20122012       INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
    2013        INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms 
     2013       INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
    20142014       INTEGER(iwp) ::  tn        !< number of OpenMP thread
    2015        
     2015
    20162016       REAL(wp)    ::  ibit0   !< flag indicating 1st-order scheme along x-direction
    20172017       REAL(wp)    ::  ibit1   !< flag indicating 3rd-order scheme along x-direction
     
    20292029       REAL(wp)    ::  gv       !< Galilei-transformation velocity along y
    20302030       REAL(wp)    ::  u_comp_l !< advection velocity along x at leftmost grid point on subdomain
    2031        
     2031
    20322032       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
    20332033       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
     
    20402040       REAL(wp), DIMENSION(nzb:nzt+1) ::  w_comp !< advection velocity along z
    20412041!
    2042 !--    Used local modified copy of nzb_max (used to degrade order of 
     2042!--    Used local modified copy of nzb_max (used to degrade order of
    20432043!--    discretization) at non-cyclic boundaries. Modify only at relevant points
    2044 !--    instead of the entire subdomain. This should lead to better 
     2044!--    instead of the entire subdomain. This should lead to better
    20452045!--    load balance between boundary and non-boundary PEs.
    20462046       IF( ( bc_dirichlet_l  .OR.  bc_radiation_l )  .AND.  i <= nxl + 2  .OR. &
     
    20522052          nzb_max_l = nzb_max
    20532053       END IF
    2054        
     2054
    20552055       gu = 2.0_wp * u_gtrans
    20562056       gv = 2.0_wp * v_gtrans
     
    20582058!--    Compute southside fluxes for the respective boundary of PE
    20592059       IF ( j == nys  )  THEN
    2060        
     2060
    20612061          DO  k = nzb+1, nzb_max_l
    20622062
     
    21042104                           37.0_wp * ( u(k,j,i)   + u(k,j-1,i)   )             &
    21052105                         -  8.0_wp * ( u(k,j+1,i) + u(k,j-2,i) )               &
    2106                          +           ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5 
     2106                         +           ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5
    21072107             diss_s_u(k,tn) = - ABS(v_comp(k)) * (                             &
    21082108                           10.0_wp * ( u(k,j,i)   - u(k,j-1,i)   )             &
     
    21112111
    21122112          ENDDO
    2113          
     2113
    21142114       ENDIF
    21152115!
    21162116!--    Compute leftside fluxes for the respective boundary of PE
    21172117       IF ( i == i_omp  .OR.  i == nxlu )  THEN
    2118        
     2118
    21192119          DO  k = nzb+1, nzb_max_l
    21202120
     
    21372137                              ) *                                              &
    21382138                                          ( u(k,j,i+2) + u(k,j,i-3) )          &
    2139                                            )                                 
    2140                                                                              
     2139                                           )
     2140
    21412141             diss_l_u(k,j,tn) = - ABS( u_comp_l ) * (                          &
    21422142                              ( 10.0_wp * ibit2 * adv_mom_5                    &
     
    21692169
    21702170          ENDDO
    2171          
     2171
    21722172       ENDIF
    21732173!
     
    21882188                                    ( u(k,j,i+1) + u(k,j,i)   )                &
    21892189              -      (  8.0_wp * ibit2 * adv_mom_5                             &
    2190                   +              ibit1 * adv_mom_3                             & 
     2190                  +              ibit1 * adv_mom_3                             &
    21912191                     ) *                                                       &
    21922192                                    ( u(k,j,i+2) + u(k,j,i-1) )                &
     
    21942194                     ) *                                                       &
    21952195                                    ( u(k,j,i+3) + u(k,j,i-2) )                &
    2196                                            )                                 
    2197                                                                              
     2196                                           )
     2197
    21982198          diss_r(k) = - ABS( u_comp(k) - gu ) * (                              &
    21992199                     ( 10.0_wp * ibit2 * adv_mom_5                             &
     
    22292229                     ) *                                                       &
    22302230                                    ( u(k,j+3,i) + u(k,j-2,i) )                &
    2231                                   )                                           
    2232                                                                              
     2231                                  )
     2232
    22332233          diss_n(k) = - ABS ( v_comp(k) ) * (                                  &
    22342234                     ( 10.0_wp * ibit5 * adv_mom_5                             &
     
    22532253                         37.0_wp * ( u(k,j,i+1) + u(k,j,i)   )                 &
    22542254                       -  8.0_wp * ( u(k,j,i+2) + u(k,j,i-1) )                 &
    2255                        +           ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_5   
     2255                       +           ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_5
    22562256          diss_r(k) = - ABS( u_comp(k) - gu ) * (                              &
    22572257                         10.0_wp * ( u(k,j,i+1) - u(k,j,i)   )                 &
    22582258                       -  5.0_wp * ( u(k,j,i+2) - u(k,j,i-1) )                 &
    2259                        +           ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_5   
    2260                                                                                
    2261           v_comp(k) = v(k,j+1,i) + v(k,j+1,i-1) - gv                           
     2259                       +           ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_5
     2260
     2261          v_comp(k) = v(k,j+1,i) + v(k,j+1,i-1) - gv
    22622262          flux_n(k) = v_comp(k) * (                                            &
    22632263                         37.0_wp * ( u(k,j+1,i) + u(k,j,i)   )                 &
    22642264                       -  8.0_wp * ( u(k,j+2,i) + u(k,j-1,i) )                 &
    2265                        +           ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_5   
     2265                       +           ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_5
    22662266          diss_n(k) = - ABS( v_comp(k) ) * (                                   &
    22672267                         10.0_wp * ( u(k,j+1,i) - u(k,j,i)   )                 &
     
    22712271       ENDDO
    22722272!
    2273 !--    Now, compute vertical fluxes. Split loop into a part treating the 
     2273!--    Now, compute vertical fluxes. Split loop into a part treating the
    22742274!--    lowest grid points with indirect indexing, a main loop without
    22752275!--    indirect indexing, and a loop for the uppermost grip points with
    22762276!--    indirect indexing. This allows better vectorization for the main loop.
    2277 !--    First, compute the flux at model surface, which need has to be 
     2277!--    First, compute the flux at model surface, which need has to be
    22782278!--    calculated explicitly for the tendency at
    22792279!--    the first w-level. For topography wall this is done implicitely by
     
    22822282       diss_t(nzb) = 0.0_wp
    22832283       w_comp(nzb) = 0.0_wp
    2284        
     2284
    22852285       DO  k = nzb+1, nzb+1
    22862286!
     
    23092309                     ) *                                                       &
    23102310                                ( u(k_ppp,j,i) + u(k_mm,j,i) )                 &
    2311                                                   )                           
    2312                                                                                
     2311                                                  )
     2312
    23132313          diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                   &
    23142314                     ( 10.0_wp * ibit8 * adv_mom_5                             &
     
    23262326                                                           )
    23272327       ENDDO
    2328        
     2328
    23292329       DO  k = nzb+2, nzt-2
    23302330
     
    23442344                     ) *                                                       &
    23452345                                ( u(k+2,j,i) + u(k-1,j,i)   )                  &
    2346               +      (           ibit8 * adv_mom_5                             & 
     2346              +      (           ibit8 * adv_mom_5                             &
    23472347                     ) *                                                       &
    23482348                                ( u(k+3,j,i) + u(k-2,j,i) )                    &
     
    23642364                                                           )
    23652365       ENDDO
    2366        
     2366
    23672367       DO  k = nzt-1, nzt-symmetry_flag
    23682368!
     
    24082408                                                           )
    24092409       ENDDO
    2410        
     2410
    24112411!
    24122412!--    Set resolved/turbulent flux at model top to zero (w-level). In case that
    24132413!--    a symmetric behavior between bottom and top shall be guaranteed (closed
    2414 !--    channel flow), the flux at nzt is also set to zero. 
     2414!--    channel flow), the flux at nzt is also set to zero.
    24152415       IF ( symmetry_flag == 1 ) THEN
    24162416          flux_t(nzt) = 0.0_wp
     
    24212421       diss_t(nzt+1) = 0.0_wp
    24222422       w_comp(nzt+1) = 0.0_wp
    2423        
     2423
    24242424       DO  k = nzb+1, nzb_max_l
    24252425
    24262426          flux_d    = flux_t(k-1)
    24272427          diss_d    = diss_t(k-1)
    2428          
     2428
    24292429          ibit2 = REAL( IBITS(advc_flags_m(k,j,i),2,1), KIND = wp )
    24302430          ibit1 = REAL( IBITS(advc_flags_m(k,j,i),1,1), KIND = wp )
    24312431          ibit0 = REAL( IBITS(advc_flags_m(k,j,i),0,1), KIND = wp )
    2432          
     2432
    24332433          ibit5 = REAL( IBITS(advc_flags_m(k,j,i),5,1), KIND = wp )
    24342434          ibit4 = REAL( IBITS(advc_flags_m(k,j,i),4,1), KIND = wp )
    24352435          ibit3 = REAL( IBITS(advc_flags_m(k,j,i),3,1), KIND = wp )
    2436          
     2436
    24372437          ibit8 = REAL( IBITS(advc_flags_m(k,j,i),8,1), KIND = wp )
    24382438          ibit7 = REAL( IBITS(advc_flags_m(k,j,i),7,1), KIND = wp )
     
    24642464                   + REAL( IBITS(advc_flags_m(k-1,j,i),7,1), KIND = wp )       &
    24652465                   + REAL( IBITS(advc_flags_m(k-1,j,i),8,1), KIND = wp )       &
    2466                                       )                                        & 
     2466                                      )                                        &
    24672467                  ) * drho_air(k) * ddzw(k)                                    &
    2468                 ) * 0.5_wp                                                     
    2469                                                                                
     2468                ) * 0.5_wp
     2469
    24702470          tend(k,j,i) = tend(k,j,i) - (                                        &
    24712471                            ( flux_r(k) + diss_r(k)                            &
     
    25042504                  ) *   weight_substep(intermediate_timestep_count)
    25052505       ENDDO
    2506        
     2506
    25072507       DO  k = nzb_max_l+1, nzt
    25082508
     
    25162516               +  ( v_comp(k) + gv  - ( v(k,j,i)   + v(k,j,i-1) ) ) * ddy      &
    25172517               +  ( w_comp(k)   * rho_air_zw(k)                                &
    2518                  -  w_comp(k-1) * rho_air_zw(k-1)                              & 
     2518                 -  w_comp(k-1) * rho_air_zw(k-1)                              &
    25192519                  ) * drho_air(k) * ddzw(k)                                    &
    25202520                ) * 0.5_wp
     
    25282528                          -   ( flux_d    + diss_d    )                        &
    25292529                                                    ) * drho_air(k) * ddzw(k)  &
    2530                                        ) + div * u(k,j,i)
     2530                                      ) + div * u(k,j,i)
    25312531
    25322532          flux_l_u(k,j,tn) = flux_r(k)
     
    25782578       INTEGER(iwp)  ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
    25792579       INTEGER(iwp)  ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
    2580        INTEGER(iwp)  ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms 
     2580       INTEGER(iwp)  ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
    25812581       INTEGER(iwp)  ::  tn        !< number of OpenMP thread
    2582        
     2582
    25832583       REAL(wp)      ::  ibit9    !< flag indicating 1st-order scheme along x-direction
    25842584       REAL(wp)      ::  ibit10   !< flag indicating 3rd-order scheme along x-direction
    25852585       REAL(wp)      ::  ibit11   !< flag indicating 5th-order scheme along x-direction
    2586        REAL(wp)      ::  ibit12   !< flag indicating 1st-order scheme along y-direction 
     2586       REAL(wp)      ::  ibit12   !< flag indicating 1st-order scheme along y-direction
    25872587       REAL(wp)      ::  ibit13   !< flag indicating 3rd-order scheme along y-direction
    25882588       REAL(wp)      ::  ibit14   !< flag indicating 3rd-order scheme along y-direction
     
    25962596       REAL(wp)      ::  gv       !< Galilei-transformation velocity along y
    25972597       REAL(wp)      ::  v_comp_l !< advection velocity along y on leftmost grid point on subdomain
    2598        
     2598
    25992599       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
    26002600       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
     
    26072607       REAL(wp), DIMENSION(nzb:nzt+1)  ::  w_comp !< advection velocity along z
    26082608!
    2609 !--    Used local modified copy of nzb_max (used to degrade order of 
     2609!--    Used local modified copy of nzb_max (used to degrade order of
    26102610!--    discretization) at non-cyclic boundaries. Modify only at relevant points
    2611 !--    instead of the entire subdomain. This should lead to better 
     2611!--    instead of the entire subdomain. This should lead to better
    26122612!--    load balance between boundary and non-boundary PEs.
    26132613       IF( ( bc_dirichlet_l  .OR.  bc_radiation_l )  .AND.  i <= nxl + 2  .OR. &
     
    26192619          nzb_max_l = nzb_max
    26202620       END IF
    2621        
     2621
    26222622       gu = 2.0_wp * u_gtrans
    26232623       gv = 2.0_wp * v_gtrans
    26242624
    2625 !       
     2625!
    26262626!--    Compute leftside fluxes for the respective boundary.
    26272627       IF ( i == i_omp )  THEN
     
    26342634
    26352635             u_comp(k)        = u(k,j-1,i) + u(k,j,i) - gu
    2636              flux_l_v(k,j,tn) = u_comp(k) * (                                 &
    2637                               ( 37.0_wp * ibit11 * adv_mom_5                  &
    2638                            +     7.0_wp * ibit10 * adv_mom_3                  &
    2639                            +              ibit9  * adv_mom_1                  &
    2640                               ) *                                             &
    2641                                         ( v(k,j,i)   + v(k,j,i-1) )           &
    2642                        -      (  8.0_wp * ibit11 * adv_mom_5                  &
    2643                            +              ibit10 * adv_mom_3                  &
    2644                               ) *                                             &
    2645                                         ( v(k,j,i+1) + v(k,j,i-2) )           &
    2646                        +      (           ibit11 * adv_mom_5                  &
    2647                               ) *                                             &
    2648                                         ( v(k,j,i+2) + v(k,j,i-3) )           &
     2636             flux_l_v(k,j,tn) = u_comp(k) * (                                  &
     2637                              ( 37.0_wp * ibit11 * adv_mom_5                   &
     2638                           +     7.0_wp * ibit10 * adv_mom_3                   &
     2639                           +              ibit9  * adv_mom_1                   &
     2640                              ) *                                              &
     2641                                        ( v(k,j,i)   + v(k,j,i-1) )            &
     2642                       -      (  8.0_wp * ibit11 * adv_mom_5                   &
     2643                           +              ibit10 * adv_mom_3                   &
     2644                              ) *                                              &
     2645                                        ( v(k,j,i+1) + v(k,j,i-2) )            &
     2646                       +      (           ibit11 * adv_mom_5                   &
     2647                              ) *                                              &
     2648                                        ( v(k,j,i+2) + v(k,j,i-3) )            &
    26492649                                            )
    26502650
    2651              diss_l_v(k,j,tn) = - ABS( u_comp(k) ) * (                        &
    2652                               ( 10.0_wp * ibit11 * adv_mom_5                  &
    2653                            +     3.0_wp * ibit10 * adv_mom_3                  &
    2654                            +              ibit9  * adv_mom_1                  &
    2655                               ) *                                             &
    2656                                         ( v(k,j,i)   - v(k,j,i-1) )           &
    2657                        -      (  5.0_wp * ibit11 * adv_mom_5                  &
    2658                            +              ibit10 * adv_mom_3                  &
    2659                               ) *                                             &
    2660                                         ( v(k,j,i+1) - v(k,j,i-2) )           &
    2661                        +      (           ibit11 * adv_mom_5                  &
    2662                               ) *                                             &
    2663                                         ( v(k,j,i+2) - v(k,j,i-3) )           &
     2651             diss_l_v(k,j,tn) = - ABS( u_comp(k) ) * (                         &
     2652                              ( 10.0_wp * ibit11 * adv_mom_5                   &
     2653                           +     3.0_wp * ibit10 * adv_mom_3                   &
     2654                           +              ibit9  * adv_mom_1                   &
     2655                              ) *                                              &
     2656                                        ( v(k,j,i)   - v(k,j,i-1) )            &
     2657                       -      (  5.0_wp * ibit11 * adv_mom_5                   &
     2658                           +              ibit10 * adv_mom_3                   &
     2659                              ) *                                              &
     2660                                        ( v(k,j,i+1) - v(k,j,i-2) )            &
     2661                       +      (           ibit11 * adv_mom_5                   &
     2662                              ) *                                              &
     2663                                        ( v(k,j,i+2) - v(k,j,i-3) )            &
    26642664                                                     )
    26652665
     
    26692669
    26702670             u_comp(k)        = u(k,j-1,i) + u(k,j,i) - gu
    2671              flux_l_v(k,j,tn) = u_comp(k) * (                                 &
    2672                              37.0_wp * ( v(k,j,i)   + v(k,j,i-1)   )          &
    2673                            -  8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) )            &
     2671             flux_l_v(k,j,tn) = u_comp(k) * (                                  &
     2672                             37.0_wp * ( v(k,j,i)   + v(k,j,i-1)   )           &
     2673                           -  8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) )             &
    26742674                           +           ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5
    2675              diss_l_v(k,j,tn) = - ABS( u_comp(k) ) * (                        &
    2676                              10.0_wp * ( v(k,j,i)   - v(k,j,i-1)   )          &
    2677                            -  5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) )            &
     2675             diss_l_v(k,j,tn) = - ABS( u_comp(k) ) * (                         &
     2676                             10.0_wp * ( v(k,j,i)   - v(k,j,i-1)   )           &
     2677                           -  5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) )             &
    26782678                           +           ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5
    26792679
    26802680          ENDDO
    2681          
     2681
    26822682       ENDIF
    26832683!
    26842684!--    Compute southside fluxes for the respective boundary.
    26852685       IF ( j == nysv )  THEN
    2686        
     2686
    26872687          DO  k = nzb+1, nzb_max_l
    26882688
     
    26922692
    26932693             v_comp_l       = v(k,j,i) + v(k,j-1,i) - gv
    2694              flux_s_v(k,tn) = v_comp_l * (                                    &
    2695                             ( 37.0_wp * ibit14 * adv_mom_5                    &
    2696                          +     7.0_wp * ibit13 * adv_mom_3                    &
    2697                          +              ibit12 * adv_mom_1                    &
    2698                             ) *                                               &
    2699                                         ( v(k,j,i)   + v(k,j-1,i) )           &
    2700                      -      (  8.0_wp * ibit14 * adv_mom_5                    &
    2701                          +              ibit13 * adv_mom_3                    &
    2702                             ) *                                               &
    2703                                         ( v(k,j+1,i) + v(k,j-2,i) )           &
    2704                      +      (           ibit14 * adv_mom_5                    &
    2705                             ) *                                               &
    2706                                         ( v(k,j+2,i) + v(k,j-3,i) )           &
     2694             flux_s_v(k,tn) = v_comp_l * (                                     &
     2695                            ( 37.0_wp * ibit14 * adv_mom_5                     &
     2696                         +     7.0_wp * ibit13 * adv_mom_3                     &
     2697                         +              ibit12 * adv_mom_1                     &
     2698                            ) *                                                &
     2699                                        ( v(k,j,i)   + v(k,j-1,i) )            &
     2700                     -      (  8.0_wp * ibit14 * adv_mom_5                     &
     2701                         +              ibit13 * adv_mom_3                     &
     2702                            ) *                                                &
     2703                                        ( v(k,j+1,i) + v(k,j-2,i) )            &
     2704                     +      (           ibit14 * adv_mom_5                     &
     2705                            ) *                                                &
     2706                                        ( v(k,j+2,i) + v(k,j-3,i) )            &
    27072707                                         )
    27082708
    2709              diss_s_v(k,tn) = - ABS( v_comp_l ) * (                           &
    2710                             ( 10.0_wp * ibit14 * adv_mom_5                    &
    2711                          +     3.0_wp * ibit13 * adv_mom_3                    &
    2712                          +              ibit12 * adv_mom_1                    &
    2713                             ) *                                               &
    2714                                         ( v(k,j,i)   - v(k,j-1,i) )           &
    2715                      -      (  5.0_wp * ibit14 * adv_mom_5                    &
    2716                          +              ibit13 * adv_mom_3                    &
    2717                             ) *                                               &
    2718                                         ( v(k,j+1,i) - v(k,j-2,i) )           &
    2719                      +      (           ibit14 * adv_mom_5                    &
    2720                             ) *                                               &
    2721                                         ( v(k,j+2,i) - v(k,j-3,i) )           &
     2709             diss_s_v(k,tn) = - ABS( v_comp_l ) * (                            &
     2710                            ( 10.0_wp * ibit14 * adv_mom_5                     &
     2711                         +     3.0_wp * ibit13 * adv_mom_3                     &
     2712                         +              ibit12 * adv_mom_1                     &
     2713                            ) *                                                &
     2714                                        ( v(k,j,i)   - v(k,j-1,i) )            &
     2715                     -      (  5.0_wp * ibit14 * adv_mom_5                     &
     2716                         +              ibit13 * adv_mom_3                     &
     2717                            ) *                                                &
     2718                                        ( v(k,j+1,i) - v(k,j-2,i) )            &
     2719                     +      (           ibit14 * adv_mom_5                     &
     2720                            ) *                                                &
     2721                                        ( v(k,j+2,i) - v(k,j-3,i) )            &
    27222722                                                  )
    27232723
     
    27272727
    27282728             v_comp_l       = v(k,j,i) + v(k,j-1,i) - gv
    2729              flux_s_v(k,tn) = v_comp_l * (                                    &
    2730                            37.0_wp * ( v(k,j,i)   + v(k,j-1,i)   )            &
    2731                          -  8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) )              &
     2729             flux_s_v(k,tn) = v_comp_l * (                                     &
     2730                           37.0_wp * ( v(k,j,i)   + v(k,j-1,i)   )             &
     2731                         -  8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) )               &
    27322732                         +           ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5
    2733              diss_s_v(k,tn) = - ABS( v_comp_l ) * (                           &
    2734                            10.0_wp * ( v(k,j,i)   - v(k,j-1,i)   )            &
    2735                          -  5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) )              &
     2733             diss_s_v(k,tn) = - ABS( v_comp_l ) * (                            &
     2734                           10.0_wp * ( v(k,j,i)   - v(k,j-1,i)   )             &
     2735                         -  5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) )               &
    27362736                         +           ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5
    27372737
    27382738          ENDDO
    2739          
     2739
    27402740       ENDIF
    27412741!
     
    27472747          ibit10 = REAL( IBITS(advc_flags_m(k,j,i),10,1), KIND = wp )
    27482748          ibit9  = REAL( IBITS(advc_flags_m(k,j,i),9,1),  KIND = wp )
    2749  
     2749
    27502750          u_comp(k) = u(k,j-1,i+1) + u(k,j,i+1) - gu
    2751           flux_r(k) = u_comp(k) * (                                           &
    2752                      ( 37.0_wp * ibit11 * adv_mom_5                           &
    2753                   +     7.0_wp * ibit10 * adv_mom_3                           &
    2754                   +              ibit9  * adv_mom_1                           &
    2755                      ) *                                                      &
    2756                                     ( v(k,j,i+1) + v(k,j,i)   )               &
    2757               -      (  8.0_wp * ibit11 * adv_mom_5                           &
    2758                   +              ibit10 * adv_mom_3                           &
    2759                      ) *                                                      &
    2760                                     ( v(k,j,i+2) + v(k,j,i-1) )               &
    2761               +      (           ibit11 * adv_mom_5                           &
    2762                      ) *                                                      &
    2763                                     ( v(k,j,i+3) + v(k,j,i-2) )               &
     2751          flux_r(k) = u_comp(k) * (                                            &
     2752                     ( 37.0_wp * ibit11 * adv_mom_5                            &
     2753                  +     7.0_wp * ibit10 * adv_mom_3                            &
     2754                  +              ibit9  * adv_mom_1                            &
     2755                     ) *                                                       &
     2756                                    ( v(k,j,i+1) + v(k,j,i)   )                &
     2757              -      (  8.0_wp * ibit11 * adv_mom_5                            &
     2758                  +              ibit10 * adv_mom_3                            &
     2759                     ) *                                                       &
     2760                                    ( v(k,j,i+2) + v(k,j,i-1) )                &
     2761              +      (           ibit11 * adv_mom_5                            &
     2762                     ) *                                                       &
     2763                                    ( v(k,j,i+3) + v(k,j,i-2) )                &
    27642764                                  )
    27652765
    2766           diss_r(k) = - ABS( u_comp(k) ) * (                                  &
    2767                      ( 10.0_wp * ibit11 * adv_mom_5                           &
    2768                   +     3.0_wp * ibit10 * adv_mom_3                           &
    2769                   +              ibit9  * adv_mom_1                           &
    2770                      ) *                                                      &
    2771                                     ( v(k,j,i+1) - v(k,j,i)  )                &
    2772               -      (  5.0_wp * ibit11 * adv_mom_5                           &
    2773                   +              ibit10 * adv_mom_3                           &
    2774                      ) *                                                      &
    2775                                     ( v(k,j,i+2) - v(k,j,i-1) )               &
    2776               +      (           ibit11 * adv_mom_5                           &
    2777                      ) *                                                      &
    2778                                     ( v(k,j,i+3) - v(k,j,i-2) )               &
     2766          diss_r(k) = - ABS( u_comp(k) ) * (                                   &
     2767                     ( 10.0_wp * ibit11 * adv_mom_5                            &
     2768                  +     3.0_wp * ibit10 * adv_mom_3                            &
     2769                  +              ibit9  * adv_mom_1                            &
     2770                     ) *                                                       &
     2771                                    ( v(k,j,i+1) - v(k,j,i)  )                 &
     2772              -      (  5.0_wp * ibit11 * adv_mom_5                            &
     2773                  +              ibit10 * adv_mom_3                            &
     2774                     ) *                                                       &
     2775                                    ( v(k,j,i+2) - v(k,j,i-1) )                &
     2776              +      (           ibit11 * adv_mom_5                            &
     2777                     ) *                                                       &
     2778                                    ( v(k,j,i+3) - v(k,j,i-2) )                &
    27792779                                           )
    27802780
     
    27852785
    27862786          v_comp(k) = v(k,j+1,i) + v(k,j,i)
    2787           flux_n(k) = ( v_comp(k) - gv ) * (                                  &
    2788                      ( 37.0_wp * ibit14 * adv_mom_5                           &
    2789                   +     7.0_wp * ibit13 * adv_mom_3                           &
    2790                   +              ibit12 * adv_mom_1                           &
    2791                      ) *                                                      &
    2792                                     ( v(k,j+1,i) + v(k,j,i)   )               &
    2793               -      (  8.0_wp * ibit14 * adv_mom_5                           &
    2794                   +              ibit13 * adv_mom_3                           &
    2795                      ) *                                                      &
    2796                                     ( v(k,j+2,i) + v(k,j-1,i) )               &
    2797               +      (           ibit14 * adv_mom_5                           &
    2798                      ) *                                                      &
    2799                                     ( v(k,j+3,i) + v(k,j-2,i) )               &
     2787          flux_n(k) = ( v_comp(k) - gv ) * (                                   &
     2788                     ( 37.0_wp * ibit14 * adv_mom_5                            &
     2789                  +     7.0_wp * ibit13 * adv_mom_3                            &
     2790                  +              ibit12 * adv_mom_1                            &
     2791                     ) *                                                       &
     2792                                    ( v(k,j+1,i) + v(k,j,i)   )                &
     2793              -      (  8.0_wp * ibit14 * adv_mom_5                            &
     2794                  +              ibit13 * adv_mom_3                            &
     2795                     ) *                                                       &
     2796                                    ( v(k,j+2,i) + v(k,j-1,i) )                &
     2797              +      (           ibit14 * adv_mom_5                            &
     2798                     ) *                                                       &
     2799                                    ( v(k,j+3,i) + v(k,j-2,i) )                &
    28002800                                           )
    28012801
    2802           diss_n(k) = - ABS( v_comp(k) - gv ) * (                             &
    2803                      ( 10.0_wp * ibit14 * adv_mom_5                           &
    2804                   +     3.0_wp * ibit13 * adv_mom_3                           &
    2805                   +              ibit12 * adv_mom_1                           &
    2806                      ) *                                                      &
    2807                                     ( v(k,j+1,i) - v(k,j,i)   )               &
    2808               -      (  5.0_wp * ibit14 * adv_mom_5                           &
    2809                   +              ibit13 * adv_mom_3                           &
    2810                      ) *                                                      &
    2811                                     ( v(k,j+2,i) - v(k,j-1,i) )               &
    2812               +      (           ibit14 * adv_mom_5                           &
    2813                      ) *                                                      &
    2814                                     ( v(k,j+3,i) - v(k,j-2,i) )               &
     2802          diss_n(k) = - ABS( v_comp(k) - gv ) * (                              &
     2803                     ( 10.0_wp * ibit14 * adv_mom_5                            &
     2804                  +     3.0_wp * ibit13 * adv_mom_3                            &
     2805                  +              ibit12 * adv_mom_1                            &
     2806                     ) *                                                       &
     2807                                    ( v(k,j+1,i) - v(k,j,i)   )                &
     2808              -      (  5.0_wp * ibit14 * adv_mom_5                            &
     2809                  +              ibit13 * adv_mom_3                            &
     2810                     ) *                                                       &
     2811                                    ( v(k,j+2,i) - v(k,j-1,i) )                &
     2812              +      (           ibit14 * adv_mom_5                            &
     2813                     ) *                                                       &
     2814                                    ( v(k,j+3,i) - v(k,j-2,i) )                &
    28152815                                                )
    28162816       ENDDO
     
    28192819
    28202820          u_comp(k) = u(k,j-1,i+1) + u(k,j,i+1) - gu
    2821           flux_r(k) = u_comp(k) * (                                           &
    2822                       37.0_wp * ( v(k,j,i+1) + v(k,j,i)   )                   &
    2823                     -  8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) )                   &
     2821          flux_r(k) = u_comp(k) * (                                            &
     2822                      37.0_wp * ( v(k,j,i+1) + v(k,j,i)   )                    &
     2823                    -  8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) )                    &
    28242824                    +           ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_5
    28252825
    2826           diss_r(k) = - ABS( u_comp(k) ) * (                                  &
    2827                       10.0_wp * ( v(k,j,i+1) - v(k,j,i) )                     &
    2828                     -  5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) )                   &
     2826          diss_r(k) = - ABS( u_comp(k) ) * (                                   &
     2827                      10.0_wp * ( v(k,j,i+1) - v(k,j,i) )                      &
     2828                    -  5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) )                    &
    28292829                    +           ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_5
    28302830
    28312831
    28322832          v_comp(k) = v(k,j+1,i) + v(k,j,i)
    2833           flux_n(k) = ( v_comp(k) - gv ) * (                                  &
    2834                       37.0_wp * ( v(k,j+1,i) + v(k,j,i)   )                   &
    2835                     -  8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) )                   &
     2833          flux_n(k) = ( v_comp(k) - gv ) * (                                   &
     2834                      37.0_wp * ( v(k,j+1,i) + v(k,j,i)   )                    &
     2835                    -  8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) )                    &
    28362836                      +         ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_5
    28372837
    2838           diss_n(k) = - ABS( v_comp(k) - gv ) * (                             &
    2839                       10.0_wp * ( v(k,j+1,i) - v(k,j,i)   )                   &
    2840                     -  5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) )                   &
     2838          diss_n(k) = - ABS( v_comp(k) - gv ) * (                              &
     2839                      10.0_wp * ( v(k,j+1,i) - v(k,j,i)   )                    &
     2840                    -  5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) )                    &
    28412841                    +           ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_5
    28422842       ENDDO
    28432843!
    2844 !--    Now, compute vertical fluxes. Split loop into a part treating the 
     2844!--    Now, compute vertical fluxes. Split loop into a part treating the
    28452845!--    lowest grid points with indirect indexing, a main loop without
    28462846!--    indirect indexing, and a loop for the uppermost grip points with
    28472847!--    indirect indexing. This allows better vectorization for the main loop.
    2848 !--    First, compute the flux at model surface, which need has to be 
     2848!--    First, compute the flux at model surface, which need has to be
    28492849!--    calculated explicitly for the tendency at
    28502850!--    the first w-level. For topography wall this is done implicitely by
     
    28532853       diss_t(nzb) = 0.0_wp
    28542854       w_comp(nzb) = 0.0_wp
    2855        
     2855
    28562856       DO  k = nzb+1, nzb+1
    28572857!
     
    28672867
    28682868          w_comp(k) = w(k,j-1,i) + w(k,j,i)
    2869           flux_t(k) = w_comp(k) * rho_air_zw(k) * (                           &
    2870                      ( 37.0_wp * ibit17 * adv_mom_5                           &
    2871                   +     7.0_wp * ibit16 * adv_mom_3                           &
    2872                   +              ibit15 * adv_mom_1                           &
    2873                      ) *                                                      &
    2874                                 ( v(k+1,j,i)   + v(k,j,i)    )                &
    2875               -      (  8.0_wp * ibit17 * adv_mom_5                           &
    2876                   +              ibit16 * adv_mom_3                           &
    2877                      ) *                                                      &
    2878                                 ( v(k_pp,j,i)  + v(k-1,j,i)  )                &
    2879               +      (           ibit17 * adv_mom_5                           &
    2880                      ) *                                                      &
    2881                                 ( v(k_ppp,j,i) + v(k_mm,j,i) )                &
     2869          flux_t(k) = w_comp(k) * rho_air_zw(k) * (                            &
     2870                     ( 37.0_wp * ibit17 * adv_mom_5                            &
     2871                  +     7.0_wp * ibit16 * adv_mom_3                            &
     2872                  +              ibit15 * adv_mom_1                            &
     2873                     ) *                                                       &
     2874                                ( v(k+1,j,i)   + v(k,j,i)    )                 &
     2875              -      (  8.0_wp * ibit17 * adv_mom_5                            &
     2876                  +              ibit16 * adv_mom_3                            &
     2877                     ) *                                                       &
     2878                                ( v(k_pp,j,i)  + v(k-1,j,i)  )                 &
     2879              +      (           ibit17 * adv_mom_5                            &
     2880                     ) *                                                       &
     2881                                ( v(k_ppp,j,i) + v(k_mm,j,i) )                 &
    28822882                                                  )
    28832883
    2884           diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                  &
    2885                      ( 10.0_wp * ibit17 * adv_mom_5                           &
    2886                   +     3.0_wp * ibit16 * adv_mom_3                           &
    2887                   +              ibit15 * adv_mom_1                           &
    2888                      ) *                                                      &
    2889                                 ( v(k+1,j,i)   - v(k,j,i)    )                &
    2890               -      (  5.0_wp * ibit17 * adv_mom_5                           &
    2891                   +              ibit16 * adv_mom_3                           &
    2892                      ) *                                                      &
    2893                                 ( v(k_pp,j,i)  - v(k-1,j,i)  )                &
    2894               +      (           ibit17 * adv_mom_5                           &
    2895                      ) *                                                      &
    2896                                 ( v(k_ppp,j,i) - v(k_mm,j,i) )                &
     2884          diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                   &
     2885                     ( 10.0_wp * ibit17 * adv_mom_5                            &
     2886                  +     3.0_wp * ibit16 * adv_mom_3                            &
     2887                  +              ibit15 * adv_mom_1                            &
     2888                     ) *                                                       &
     2889                                ( v(k+1,j,i)   - v(k,j,i)    )                 &
     2890              -      (  5.0_wp * ibit17 * adv_mom_5                            &
     2891                  +              ibit16 * adv_mom_3                            &
     2892                     ) *                                                       &
     2893                                ( v(k_pp,j,i)  - v(k-1,j,i)  )                 &
     2894              +      (           ibit17 * adv_mom_5                            &
     2895                     ) *                                                       &
     2896                                ( v(k_ppp,j,i) - v(k_mm,j,i) )                 &
    28972897                                                           )
    28982898       ENDDO
    2899        
     2899
    29002900       DO  k = nzb+2, nzt-2
    29012901
     
    29052905
    29062906          w_comp(k) = w(k,j-1,i) + w(k,j,i)
    2907           flux_t(k) = w_comp(k) * rho_air_zw(k) * (                           &
    2908                      ( 37.0_wp * ibit17 * adv_mom_5                           &
    2909                   +     7.0_wp * ibit16 * adv_mom_3                           &
    2910                   +              ibit15 * adv_mom_1                           &
    2911                      ) *                                                      &
    2912                                 ( v(k+1,j,i) + v(k,j,i)   )                   &
    2913               -      (  8.0_wp * ibit17 * adv_mom_5                           &
    2914                   +              ibit16 * adv_mom_3                           &
    2915                      ) *                                                      &
    2916                                 ( v(k+2,j,i) + v(k-1,j,i) )                   &
    2917               +      (           ibit17 * adv_mom_5                           &
    2918                      ) *                                                      &
    2919                                 ( v(k+3,j,i) + v(k-2,j,i) )                   &
     2907          flux_t(k) = w_comp(k) * rho_air_zw(k) * (                            &
     2908                     ( 37.0_wp * ibit17 * adv_mom_5                            &
     2909                  +     7.0_wp * ibit16 * adv_mom_3                            &
     2910                  +              ibit15 * adv_mom_1                            &
     2911                     ) *                                                       &
     2912                                ( v(k+1,j,i) + v(k,j,i)   )                    &
     2913              -      (  8.0_wp * ibit17 * adv_mom_5                            &
     2914                  +              ibit16 * adv_mom_3                            &
     2915                     ) *                                                       &
     2916                                ( v(k+2,j,i) + v(k-1,j,i) )                    &
     2917              +      (           ibit17 * adv_mom_5                            &
     2918                     ) *                                                       &
     2919                                ( v(k+3,j,i) + v(k-2,j,i) )                    &
    29202920                                                  )
    29212921
    2922           diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                  &
    2923                      ( 10.0_wp * ibit17 * adv_mom_5                           &
    2924                   +     3.0_wp * ibit16 * adv_mom_3                           &
    2925                   +              ibit15 * adv_mom_1                           &
    2926                      ) *                                                      &
    2927                                 ( v(k+1,j,i) - v(k,j,i)   )                   &
    2928               -      (  5.0_wp * ibit17 * adv_mom_5                           &
    2929                   +              ibit16 * adv_mom_3                           &
    2930                      ) *                                                      &
     2922          diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                   &
     2923                     ( 10.0_wp * ibit17 * adv_mom_5                            &
     2924                  +     3.0_wp * ibit16 * adv_mom_3                            &
     2925                  +              ibit15 * adv_mom_1                            &
     2926                     ) *                                                       &
     2927                                ( v(k+1,j,i) - v(k,j,i)   )                    &
     2928              -      (  5.0_wp * ibit17 * adv_mom_5                            &
     2929                  +              ibit16 * adv_mom_3                            &
     2930                     ) *                                                       &
    29312931                                ( v(k+2,j,i) - v(k-1,j,i) )                    &
    2932               +      (           ibit17 * adv_mom_5                           &
    2933                      ) *                                                      &
    2934                                 ( v(k+3,j,i) - v(k-2,j,i) )                   &
     2932              +      (           ibit17 * adv_mom_5                            &
     2933                     ) *                                                       &
     2934                                ( v(k+3,j,i) - v(k-2,j,i) )                    &
    29352935                                                           )
    29362936       ENDDO
    2937        
     2937
    29382938       DO  k = nzt-1, nzt-symmetry_flag
    29392939!
     
    29492949
    29502950          w_comp(k) = w(k,j-1,i) + w(k,j,i)
    2951           flux_t(k) = w_comp(k) * rho_air_zw(k) * (                           &
    2952                      ( 37.0_wp * ibit17 * adv_mom_5                           &
    2953                   +     7.0_wp * ibit16 * adv_mom_3                           &
    2954                   +              ibit15 * adv_mom_1                           &
    2955                      ) *                                                      &
    2956                                 ( v(k+1,j,i)   + v(k,j,i)    )                &
    2957               -      (  8.0_wp * ibit17 * adv_mom_5                           &
    2958                   +              ibit16 * adv_mom_3                           &
    2959                      ) *                                                      &
    2960                                 ( v(k_pp,j,i)  + v(k-1,j,i)  )                &
    2961               +      (           ibit17 * adv_mom_5                           &
    2962                      ) *                                                      &
    2963                                 ( v(k_ppp,j,i) + v(k_mm,j,i) )                &
     2951          flux_t(k) = w_comp(k) * rho_air_zw(k) * (                            &
     2952                     ( 37.0_wp * ibit17 * adv_mom_5                            &
     2953                  +     7.0_wp * ibit16 * adv_mom_3                            &
     2954                  +              ibit15 * adv_mom_1                            &
     2955                     ) *                                                       &
     2956                                ( v(k+1,j,i)   + v(k,j,i)    )                 &
     2957              -      (  8.0_wp * ibit17 * adv_mom_5                            &
     2958                  +              ibit16 * adv_mom_3                            &
     2959                     ) *                                                       &
     2960                                ( v(k_pp,j,i)  + v(k-1,j,i)  )                 &
     2961              +      (           ibit17 * adv_mom_5                            &
     2962                     ) *                                                       &
     2963                                ( v(k_ppp,j,i) + v(k_mm,j,i) )                 &
    29642964                                                  )
    29652965
    2966           diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                  &
    2967                      ( 10.0_wp * ibit17 * adv_mom_5                           &
    2968                   +     3.0_wp * ibit16 * adv_mom_3                           &
    2969                   +              ibit15 * adv_mom_1                           &
    2970                      ) *                                                      &
    2971                                 ( v(k+1,j,i)   - v(k,j,i)    )                &
    2972               -      (  5.0_wp * ibit17 * adv_mom_5                           &
    2973                   +              ibit16 * adv_mom_3                           &
    2974                      ) *                                                      &
    2975                                 ( v(k_pp,j,i)  - v(k-1,j,i)  )                &
    2976               +      (           ibit17 * adv_mom_5                           &
    2977                      ) *                                                      &
    2978                                 ( v(k_ppp,j,i) - v(k_mm,j,i) )                &
     2966          diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (                   &
     2967                     ( 10.0_wp * ibit17 * adv_mom_5                            &
     2968                  +     3.0_wp * ibit16 * adv_mom_3                            &
     2969                  +              ibit15 * adv_mom_1                            &
     2970                     ) *                                                       &
     2971                                ( v(k+1,j,i)   - v(k,j,i)    )                 &
     2972              -      (  5.0_wp * ibit17 * adv_mom_5                            &
     2973                  +              ibit16 * adv_mom_3                            &
     2974                     ) *                                                       &
     2975                                ( v(k_pp,j,i)  - v(k-1,j,i)  )                 &
     2976              +      (           ibit17 * adv_mom_5                            &
     2977                     ) *                                                       &
     2978                                ( v(k_ppp,j,i) - v(k_mm,j,i) )                 &
    29792979                                                           )
    29802980       ENDDO
    2981        
     2981
    29822982!
    29832983!--    Set resolved/turbulent flux at model top to zero (w-level). In case that
    29842984!--    a symmetric behavior between bottom and top shall be guaranteed (closed
    2985 !--    channel flow), the flux at nzt is also set to zero. 
     2985!--    channel flow), the flux at nzt is also set to zero.
    29862986       IF ( symmetry_flag == 1 ) THEN
    29872987          flux_t(nzt) = 0.0_wp
     
    29922992       diss_t(nzt+1) = 0.0_wp
    29932993       w_comp(nzt+1) = 0.0_wp
    2994        
     2994
    29952995       DO  k = nzb+1, nzb_max_l
    29962996
    29972997          flux_d    = flux_t(k-1)
    29982998          diss_d    = diss_t(k-1)
    2999          
     2999
    30003000          ibit11 = REAL( IBITS(advc_flags_m(k,j,i),11,1), KIND = wp )
    30013001          ibit10 = REAL( IBITS(advc_flags_m(k,j,i),10,1), KIND = wp )
    30023002          ibit9  = REAL( IBITS(advc_flags_m(k,j,i),9,1),  KIND = wp )
    3003          
     3003
    30043004          ibit14 = REAL( IBITS(advc_flags_m(k,j,i),14,1), KIND = wp )
    30053005          ibit13 = REAL( IBITS(advc_flags_m(k,j,i),13,1), KIND = wp )
    30063006          ibit12 = REAL( IBITS(advc_flags_m(k,j,i),12,1), KIND = wp )
    3007          
     3007
    30083008          ibit17 = REAL( IBITS(advc_flags_m(k,j,i),17,1), KIND = wp )
    30093009          ibit16 = REAL( IBITS(advc_flags_m(k,j,i),16,1), KIND = wp )
     
    30133013!--       correction is needed to overcome numerical instabilities introduced
    30143014!--       by a not sufficient reduction of divergences near topography.
    3015           div = ( ( ( u_comp(k)     + gu )                                    &
    3016                                        * ( ibit9 + ibit10 + ibit11 )          &
    3017                   - ( u(k,j-1,i) + u(k,j,i) )                                 &
    3018                                        * (                                    &
    3019                         REAL( IBITS(advc_flags_m(k,j,i-1),9,1),  KIND = wp )  &
    3020                       + REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp )  &
    3021                       + REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp )  &
    3022                                          )                                    &
    3023                   ) * ddx                                                     &
    3024                +  ( v_comp(k)                                                 &
    3025                                        * ( ibit12 + ibit13 + ibit14 )         &
    3026                 - ( v(k,j,i)     + v(k,j-1,i) )                               &
    3027                                        * (                                    &
    3028                         REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp )  &
    3029                       + REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp )  &
    3030                       + REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp )  &
    3031                                          )                                    &
    3032                   ) * ddy                                                     &
    3033                +  ( w_comp(k)   * rho_air_zw(k) * ( ibit15 + ibit16 + ibit17 )&
    3034                 -   w_comp(k-1) * rho_air_zw(k-1)                             &
    3035                                        * (                                    &
    3036                         REAL( IBITS(advc_flags_m(k-1,j,i),15,1), KIND = wp )  &
    3037                       + REAL( IBITS(advc_flags_m(k-1,j,i),16,1), KIND = wp )  &
    3038                       + REAL( IBITS(advc_flags_m(k-1,j,i),17,1), KIND = wp )  &
    3039                                          )                                    &
    3040                    ) * drho_air(k) * ddzw(k)                                  &
     3015          div = ( ( ( u_comp(k)     + gu )                                     &
     3016                                       * ( ibit9 + ibit10 + ibit11 )           &
     3017                  - ( u(k,j-1,i) + u(k,j,i) )                                  &
     3018                                       * (                                     &
     3019                        REAL( IBITS(advc_flags_m(k,j,i-1),9,1),  KIND = wp )   &
     3020                      + REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp )   &
     3021                      + REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp )   &
     3022                                         )                                     &
     3023                  ) * ddx                                                      &
     3024               +  ( v_comp(k)                                                  &
     3025                                       * ( ibit12 + ibit13 + ibit14 )          &
     3026                - ( v(k,j,i)     + v(k,j-1,i) )                                &
     3027                                       * (                                     &
     3028                        REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp )   &
     3029                      + REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp )   &
     3030                      + REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp )   &
     3031                                         )                                     &
     3032                  ) * ddy                                                      &
     3033               +  ( w_comp(k)   * rho_air_zw(k) * ( ibit15 + ibit16 + ibit17 ) &
     3034                -   w_comp(k-1) * rho_air_zw(k-1)                              &
     3035                                       * (                                     &
     3036                        REAL( IBITS(advc_flags_m(k-1,j,i),15,1), KIND = wp )   &
     3037                      + REAL( IBITS(advc_flags_m(k-1,j,i),16,1), KIND = wp )   &
     3038                      + REAL( IBITS(advc_flags_m(k-1,j,i),17,1), KIND = wp )   &
     3039                                         )                                     &
     3040                   ) * drho_air(k) * ddzw(k)                                   &
    30413041                ) * 0.5_wp
    30423042
    3043           tend(k,j,i) = tend(k,j,i) - (                                       &
    3044                          ( flux_r(k) + diss_r(k)                              &
    3045                        -   flux_l_v(k,j,tn) - diss_l_v(k,j,tn)   ) * ddx      &
    3046                        + ( flux_n(k) + diss_n(k)                              &
    3047                        -   flux_s_v(k,tn) - diss_s_v(k,tn)       ) * ddy      &
    3048                        + ( ( flux_t(k) + diss_t(k) )                          &
    3049                        -   ( flux_d    + diss_d    )                          &
    3050                                                    ) * drho_air(k) * ddzw(k)  &
     3043          tend(k,j,i) = tend(k,j,i) - (                                        &
     3044                         ( flux_r(k) + diss_r(k)                               &
     3045                       -   flux_l_v(k,j,tn) - diss_l_v(k,j,tn)   ) * ddx       &
     3046                       + ( flux_n(k) + diss_n(k)                               &
     3047                       -   flux_s_v(k,tn) - diss_s_v(k,tn)       ) * ddy       &
     3048                       + ( ( flux_t(k) + diss_t(k) )                           &
     3049                       -   ( flux_d    + diss_d    )                           &
     3050                                                   ) * drho_air(k) * ddzw(k)   &
    30513051                                      ) + v(k,j,i) * div
    30523052
     
    30783078
    30793079       ENDDO
    3080        
     3080
    30813081       DO  k = nzb_max_l+1, nzt
    30823082
     
    31523152       INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
    31533153       INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
    3154        INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms 
     3154       INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
    31553155       INTEGER(iwp) ::  tn        !< number of OpenMP thread
    3156        
     3156
    31573157       REAL(wp)    ::  ibit18  !< flag indicating 1st-order scheme along x-direction
    31583158       REAL(wp)    ::  ibit19  !< flag indicating 3rd-order scheme along x-direction
     
    31693169       REAL(wp)    ::  gu      !< Galilei-transformation velocity along x
    31703170       REAL(wp)    ::  gv      !< Galilei-transformation velocity along y
    3171        
     3171
    31723172       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
    31733173       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
     
    31803180       REAL(wp), DIMENSION(nzb:nzt+1)  ::  w_comp !< advection velocity along z
    31813181!
    3182 !--    Used local modified copy of nzb_max (used to degrade order of 
     3182!--    Used local modified copy of nzb_max (used to degrade order of
    31833183!--    discretization) at non-cyclic boundaries. Modify only at relevant points
    3184 !--    instead of the entire subdomain. This should lead to better 
     3184!--    instead of the entire subdomain. This should lead to better
    31853185!--    load balance between boundary and non-boundary PEs.
    31863186       IF( ( bc_dirichlet_l  .OR.  bc_radiation_l )  .AND.  i <= nxl + 2  .OR. &
     
    31923192          nzb_max_l = nzb_max
    31933193       END IF
    3194        
     3194
    31953195       gu = 2.0_wp * u_gtrans
    31963196       gv = 2.0_wp * v_gtrans
     
    32053205
    32063206             v_comp(k)      = v(k+1,j,i) + v(k,j,i) - gv
    3207              flux_s_w(k,tn) = v_comp(k) * (                                   &
    3208                             ( 37.0_wp * ibit23 * adv_mom_5                    &
    3209                          +     7.0_wp * ibit22 * adv_mom_3                    &
    3210                          +              ibit21 * adv_mom_1                    &
    3211                             ) *                                               &
    3212                                         ( w(k,j,i)   + w(k,j-1,i) )           &
    3213                      -      (  8.0_wp * ibit23 * adv_mom_5                    &
    3214                          +              ibit22 * adv_mom_3                    &
    3215                             ) *                                               &
    3216                                         ( w(k,j+1,i) + w(k,j-2,i) )           &
    3217                      +      (           ibit23 * adv_mom_5                    &
    3218                             ) *                                               &
    3219                                         ( w(k,j+2,i) + w(k,j-3,i) )           &
     3207             flux_s_w(k,tn) = v_comp(k) * (                                    &
     3208                            ( 37.0_wp * ibit23 * adv_mom_5                     &
     3209                         +     7.0_wp * ibit22 * adv_mom_3                     &
     3210                         +              ibit21 * adv_mom_1                     &
     3211                            ) *                                                &
     3212                                        ( w(k,j,i)   + w(k,j-1,i) )            &
     3213                     -      (  8.0_wp * ibit23 * adv_mom_5                     &
     3214                         +              ibit22 * adv_mom_3                     &
     3215                            ) *                                                &
     3216                                        ( w(k,j+1,i) + w(k,j-2,i) )            &
     3217                     +      (           ibit23 * adv_mom_5                     &
     3218                            ) *                                                &
     3219                                        ( w(k,j+2,i) + w(k,j-3,i) )            &
    32203220                                          )
    32213221
    3222              diss_s_w(k,tn) = - ABS( v_comp(k) ) * (                          &
    3223                             ( 10.0_wp * ibit23 * adv_mom_5                    &
    3224                          +     3.0_wp * ibit22 * adv_mom_3                    &
    3225                          +              ibit21 * adv_mom_1                    &
    3226                             ) *                                               &
    3227                                         ( w(k,j,i)   - w(k,j-1,i) )           &
    3228                      -      (  5.0_wp * ibit23 * adv_mom_5                    &
    3229                          +              ibit22 * adv_mom_3                    &
    3230                             ) *                                               &
    3231                                         ( w(k,j+1,i) - w(k,j-2,i) )           &
    3232                      +      (           ibit23 * adv_mom_5                    &
    3233                             ) *                                               &
    3234                                         ( w(k,j+2,i) - w(k,j-3,i) )           &
     3222             diss_s_w(k,tn) = - ABS( v_comp(k) ) * (                           &
     3223                            ( 10.0_wp * ibit23 * adv_mom_5                     &
     3224                         +     3.0_wp * ibit22 * adv_mom_3                     &
     3225                         +              ibit21 * adv_mom_1                     &
     3226                            ) *                                                &
     3227                                        ( w(k,j,i)   - w(k,j-1,i) )            &
     3228                     -      (  5.0_wp * ibit23 * adv_mom_5                     &
     3229                         +              ibit22 * adv_mom_3                     &
     3230                            ) *                                                &
     3231                                        ( w(k,j+1,i) - w(k,j-2,i) )            &
     3232                     +      (           ibit23 * adv_mom_5                     &
     3233                            ) *                                                &
     3234                                        ( w(k,j+2,i) - w(k,j-3,i) )            &
    32353235                                                   )
    32363236
     
    32403240
    32413241             v_comp(k)      = v(k+1,j,i) + v(k,j,i) - gv
    3242              flux_s_w(k,tn) = v_comp(k) * (                                   &
    3243                            37.0_wp * ( w(k,j,i)   + w(k,j-1,i) )              &
    3244                          -  8.0_wp * ( w(k,j+1,i) + w(k,j-2,i) )              &
     3242             flux_s_w(k,tn) = v_comp(k) * (                                    &
     3243                           37.0_wp * ( w(k,j,i)   + w(k,j-1,i) )               &
     3244                         -  8.0_wp * ( w(k,j+1,i) + w(k,j-2,i) )               &
    32453245                         +           ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5
    3246              diss_s_w(k,tn) = - ABS( v_comp(k) ) * (                          &
    3247                            10.0_wp * ( w(k,j,i)   - w(k,j-1,i) )              &
    3248                          -  5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) )              &
     3246             diss_s_w(k,tn) = - ABS( v_comp(k) ) * (                           &
     3247                           10.0_wp * ( w(k,j,i)   - w(k,j-1,i) )               &
     3248                         -  5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) )               &
    32493249                         +           ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5
    32503250
     
    32633263
    32643264             u_comp(k)        = u(k+1,j,i) + u(k,j,i) - gu
    3265              flux_l_w(k,j,tn) = u_comp(k) * (                                 &
    3266                              ( 37.0_wp * ibit20 * adv_mom_5                   &
    3267                           +     7.0_wp * ibit19 * adv_mom_3                   &
    3268                           +              ibit18 * adv_mom_1                   &
    3269                              ) *                                              &
    3270                                         ( w(k,j,i)   + w(k,j,i-1) )           &
    3271                       -      (  8.0_wp * ibit20 * adv_mom_5                   &
    3272                           +              ibit19 * adv_mom_3                   &
    3273                              ) *                                              &
    3274                                         ( w(k,j,i+1) + w(k,j,i-2) )           &
    3275                       +      (           ibit20 * adv_mom_5                   &
    3276                              ) *                                              &
    3277                                         ( w(k,j,i+2) + w(k,j,i-3) )           &
     3265             flux_l_w(k,j,tn) = u_comp(k) * (                                  &
     3266                             ( 37.0_wp * ibit20 * adv_mom_5                    &
     3267                          +     7.0_wp * ibit19 * adv_mom_3                    &
     3268                          +              ibit18 * adv_mom_1                    &
     3269                             ) *                                               &
     3270                                        ( w(k,j,i)   + w(k,j,i-1) )            &
     3271                      -      (  8.0_wp * ibit20 * adv_mom_5                    &
     3272                          +              ibit19 * adv_mom_3                    &
     3273                             ) *                                               &
     3274                                        ( w(k,j,i+1) + w(k,j,i-2) )            &
     3275                      +      (           ibit20 * adv_mom_5                    &
     3276                             ) *                                               &
     3277                                        ( w(k,j,i+2) + w(k,j,i-3) )            &
    32783278                                            )
    32793279
    3280              diss_l_w(k,j,tn) = - ABS( u_comp(k) ) * (                        &
    3281                              ( 10.0_wp * ibit20 * adv_mom_5                   &
    3282                           +     3.0_wp * ibit19 * adv_mom_3                   &
    3283                           +              ibit18 * adv_mom_1                   &
    3284                              ) *                                              &
    3285                                         ( w(k,j,i)   - w(k,j,i-1) )           &
    3286                       -      (  5.0_wp * ibit20 * adv_mom_5                   &
    3287                           +              ibit19 * adv_mom_3                   &
    3288                              ) *                                              &
    3289                                         ( w(k,j,i+1) - w(k,j,i-2) )           &
    3290                       +      (           ibit20 * adv_mom_5                   &
    3291                              ) *                                              &
    3292                                         ( w(k,j,i+2) - w(k,j,i-3) )           &
     3280             diss_l_w(k,j,tn) = - ABS( u_comp(k) ) * (                         &
     3281                             ( 10.0_wp * ibit20 * adv_mom_5                    &
     3282                          +     3.0_wp * ibit19 * adv_mom_3                    &
     3283                          +              ibit18 * adv_mom_1                    &
     3284                             ) *                                               &
     3285                                        ( w(k,j,i)   - w(k,j,i-1) )            &
     3286                      -      (  5.0_wp * ibit20 * adv_mom_5                    &
     3287                          +              ibit19 * adv_mom_3                    &
     3288                             ) *                                               &
     3289                                        ( w(k,j,i+1) - w(k,j,i-2) )            &
     3290                      +      (           ibit20 * adv_mom_5                    &
     3291                             ) *                                               &
     3292                                        ( w(k,j,i+2) - w(k,j,i-3) )            &
    32933293                                                     )
    32943294
     
    32983298
    32993299             u_comp(k)        = u(k+1,j,i) + u(k,j,i) - gu
    3300              flux_l_w(k,j,tn) = u_comp(k) * (                                 &
    3301                             37.0_wp * ( w(k,j,i)   + w(k,j,i-1) )             &
    3302                           -  8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) )             &
     3300             flux_l_w(k,j,tn) = u_comp(k) * (                                  &
     3301                            37.0_wp * ( w(k,j,i)   + w(k,j,i-1) )              &
     3302                          -  8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) )              &
    33033303                          +           ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5
    3304              diss_l_w(k,j,tn) = - ABS( u_comp(k) ) * (                        &
    3305                             10.0_wp * ( w(k,j,i)   - w(k,j,i-1) )             &
    3306                           -  5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) )             &
    3307                           +           ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5 
     3304             diss_l_w(k,j,tn) = - ABS( u_comp(k) ) * (                         &
     3305                            10.0_wp * ( w(k,j,i)   - w(k,j,i-1) )              &
     3306                          -  5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) )              &
     3307                          +           ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5
    33083308
    33093309          ENDDO
     
    33203320
    33213321          u_comp(k) = u(k+1,j,i+1) + u(k,j,i+1) - gu
    3322           flux_r(k) = u_comp(k) * (                                           &
    3323                      ( 37.0_wp * ibit20 * adv_mom_5                           &
    3324                   +     7.0_wp * ibit19 * adv_mom_3                           &
    3325                   +              ibit18 * adv_mom_1                           &
    3326                      ) *                                                      &
    3327                                     ( w(k,j,i+1) + w(k,j,i)   )               &
    3328               -      (  8.0_wp * ibit20 * adv_mom_5                           &
    3329                   +              ibit19 * adv_mom_3                           &
    3330                      ) *                                                      &
    3331                                     ( w(k,j,i+2) + w(k,j,i-1) )               &
    3332               +      (           ibit20 * adv_mom_5                           &
    3333                      ) *                                                      &
    3334                                     ( w(k,j,i+3) + w(k,j,i-2) )               &
     3322          flux_r(k) = u_comp(k) * (                                            &
     3323                     ( 37.0_wp * ibit20 * adv_mom_5                            &
     3324                  +     7.0_wp * ibit19 * adv_mom_3                            &
     3325                  +              ibit18 * adv_mom_1                            &
     3326                     ) *                                                       &
     3327                                    ( w(k,j,i+1) + w(k,j,i)   )                &
     3328              -      (  8.0_wp * ibit20 * adv_mom_5                            &
     3329                  +              ibit19 * adv_mom_3                            &
     3330                     ) *                                                       &
     3331                                    ( w(k,j,i+2) + w(k,j,i-1) )                &
     3332              +      (           ibit20 * adv_mom_5                            &
     3333                     ) *                                                       &
     3334                                    ( w(k,j,i+3) + w(k,j,i-2) )                &
    33353335                                  )
    33363336
    3337           diss_r(k) = - ABS( u_comp(k) ) * (                                  &
    3338                      ( 10.0_wp * ibit20 * adv_mom_5                           &
    3339                   +     3.0_wp * ibit19 * adv_mom_3                           &
    3340                   +              ibit18 * adv_mom_1                           &
    3341                      ) *                                                      &
    3342                                     ( w(k,j,i+1) - w(k,j,i)   )               &
    3343               -      (  5.0_wp * ibit20 * adv_mom_5                           &
    3344                   +              ibit19 * adv_mom_3                           &
    3345                      ) *                                                      &
    3346                                     ( w(k,j,i+2) - w(k,j,i-1) )               &
    3347               +      (           ibit20 * adv_mom_5                           &
    3348                      ) *                                                      &
    3349                                     ( w(k,j,i+3) - w(k,j,i-2) )               &
     3337          diss_r(k) = - ABS( u_comp(k) ) * (                                   &
     3338                     ( 10.0_wp * ibit20 * adv_mom_5                            &
     3339                  +     3.0_wp * ibit19 * adv_mom_3                            &
     3340                  +              ibit18 * adv_mom_1                            &
     3341                     ) *                                                       &
     3342                                    ( w(k,j,i+1) - w(k,j,i)   )                &
     3343              -      (  5.0_wp * ibit20 * adv_mom_5                            &
     3344                  +              ibit19 * adv_mom_3                            &
     3345                     ) *                                                       &
     3346                                    ( w(k,j,i+2) - w(k,j,i-1) )                &
     3347              +      (           ibit20 * adv_mom_5                            &
     3348                     ) *                                                       &
     3349                                    ( w(k,j,i+3) - w(k,j,i-2) )                &
    33503350                                           )
    33513351
     
    33553355
    33563356          v_comp(k) = v(k+1,j+1,i) + v(k,j+1,i) - gv
    3357           flux_n(k) = v_comp(k) * (                                           &
    3358                      ( 37.0_wp * ibit23 * adv_mom_5                           &
    3359                   +     7.0_wp * ibit22 * adv_mom_3                           &
    3360                   +              ibit21 * adv_mom_1                           &
    3361                      ) *                                                      &
    3362                                     ( w(k,j+1,i) + w(k,j,i)   )               &
    3363               -      (  8.0_wp * ibit23 * adv_mom_5                           &
    3364                   +              ibit22 * adv_mom_3                           &
    3365                      ) *                                                      &
    3366                                     ( w(k,j+2,i) + w(k,j-1,i) )               &
    3367               +      (           ibit23 * adv_mom_5                           &
    3368                      ) *                                                      &
    3369                                     ( w(k,j+3,i) + w(k,j-2,i) )               &
     3357          flux_n(k) = v_comp(k) * (                                            &
     3358                     ( 37.0_wp * ibit23 * adv_mom_5                            &
     3359                  +     7.0_wp * ibit22 * adv_mom_3                            &
     3360                  +              ibit21 * adv_mom_1                            &
     3361                     ) *                                                       &
     3362                                    ( w(k,j+1,i) + w(k,j,i)   )                &
     3363              -      (  8.0_wp * ibit23 * adv_mom_5                            &
     3364                  +              ibit22 * adv_mom_3                            &
     3365                     ) *                                                       &
     3366                                    ( w(k,j+2,i) + w(k,j-1,i) )                &
     3367              +      (           ibit23 * adv_mom_5                            &
     3368                     ) *                                                       &
     3369                                    ( w(k,j+3,i) + w(k,j-2,i) )                &
    33703370                                  )
    33713371
    3372           diss_n(k) = - ABS( v_comp(k) ) * (                                  &
    3373                      ( 10.0_wp * ibit23 * adv_mom_5                           &
    3374                   +     3.0_wp * ibit22 * adv_mom_3                           &
    3375                   +              ibit21 * adv_mom_1                           &
    3376                      ) *                                                      &
    3377                                     ( w(k,j+1,i) - w(k,j,i)   )               &
    3378               -      (  5.0_wp * ibit23 * adv_mom_5                           &
    3379                   +              ibit22 * adv_mom_3                           &
    3380                      ) *                                                      &
    3381                                    ( w(k,j+2,i)  - w(k,j-1,i) )               &
    3382               +      (           ibit23 * adv_mom_5                           &
    3383                      ) *                                                      &
    3384                                    ( w(k,j+3,i)  - w(k,j-2,i) )               &
     3372          diss_n(k) = - ABS( v_comp(k) ) * (                                   &
     3373                     ( 10.0_wp * ibit23 * adv_mom_5                            &
     3374                  +     3.0_wp * ibit22 * adv_mom_3                            &
     3375                  +              ibit21 * adv_mom_1                            &
     3376                     ) *                                                       &
     3377                                    ( w(k,j+1,i) - w(k,j,i)   )                &
     3378              -      (  5.0_wp * ibit23 * adv_mom_5                            &
     3379                  +              ibit22 * adv_mom_3                            &
     3380                     ) *                                                       &
     3381                                   ( w(k,j+2,i)  - w(k,j-1,i) )                &
     3382              +      (           ibit23 * adv_mom_5                            &
     3383                     ) *                                                       &
     3384                                   ( w(k,j+3,i)  - w(k,j-2,i) )                &
    33853385                                           )
    33863386       ENDDO
     
    33893389
    33903390          u_comp(k) = u(k+1,j,i+1) + u(k,j,i+1) - gu
    3391           flux_r(k) = u_comp(k) * (                                           &
    3392                       37.0_wp * ( w(k,j,i+1) + w(k,j,i)   )                   &
    3393                     -  8.0_wp * ( w(k,j,i+2) + w(k,j,i-1) )                   &
     3391          flux_r(k) = u_comp(k) * (                                            &
     3392                      37.0_wp * ( w(k,j,i+1) + w(k,j,i)   )                    &
     3393                    -  8.0_wp * ( w(k,j,i+2) + w(k,j,i-1) )                    &
    33943394                    +           ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_5
    33953395
    3396           diss_r(k) = - ABS( u_comp(k) ) * (                                  &
    3397                       10.0_wp * ( w(k,j,i+1) - w(k,j,i)   )                   &
    3398                     -  5.0_wp * ( w(k,j,i+2) - w(k,j,i-1) )                   &
     3396          diss_r(k) = - ABS( u_comp(k) ) * (                                   &
     3397                      10.0_wp * ( w(k,j,i+1) - w(k,j,i)   )                    &
     3398                    -  5.0_wp * ( w(k,j,i+2) - w(k,j,i-1) )                    &
    33993399                    +           ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_5
    34003400
    34013401          v_comp(k) = v(k+1,j+1,i) + v(k,j+1,i) - gv
    3402           flux_n(k) = v_comp(k) * (                                           &
    3403                       37.0_wp * ( w(k,j+1,i) + w(k,j,i)   )                   &
    3404                     -  8.0_wp * ( w(k,j+2,i) + w(k,j-1,i) )                   &
     3402          flux_n(k) = v_comp(k) * (                                            &
     3403                      37.0_wp * ( w(k,j+1,i) + w(k,j,i)   )                    &
     3404                    -  8.0_wp * ( w(k,j+2,i) + w(k,j-1,i) )                    &
    34053405                    +           ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_5
    34063406
    3407           diss_n(k) = - ABS( v_comp(k) ) * (                                  &
    3408                       10.0_wp * ( w(k,j+1,i) - w(k,j,i)   )                   &
    3409                     -  5.0_wp * ( w(k,j+2,i) - w(k,j-1,i) )                   &
     3407          diss_n(k) = - ABS( v_comp(k) ) * (                                   &
     3408                      10.0_wp * ( w(k,j+1,i) - w(k,j,i)   )                    &
     3409                    -  5.0_wp * ( w(k,j+2,i) - w(k,j-1,i) )                    &
    34103410                    +           ( w(k,j+3,i) - w(k,j-2,i) ) ) * adv_mom_5
    34113411       ENDDO
    34123412
    34133413!
    3414 !--    Now, compute vertical fluxes. Split loop into a part treating the 
     3414!--    Now, compute vertical fluxes. Split loop into a part treating the
    34153415!--    lowest grid points with indirect indexing, a main loop without
    34163416!--    indirect indexing, and a loop for the uppermost grip points with
    34173417!--    indirect indexing. This allows better vectorization for the main loop.
    3418 !--    First, compute the flux at model surface, which need has to be 
     3418!--    First, compute the flux at model surface, which need has to be
    34193419!--    calculated explicitly for the tendency at
    34203420!--    the first w-level. For topography wall this is done implicitely by
    3421 !--    advc_flags_m.
     3421!--    advc_flags_m. First, compute flux at lowest level, located at z=dz/2.
    34223422       k         = nzb + 1
    34233423       w_comp(k) = w(k,j,i) + w(k-1,j,i)
     
    34263426       diss_t(0) = -ABS(w_comp(k)) * rho_air(k)                                &
    34273427                 * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1
    3428        
     3428
    34293429       DO  k = nzb+1, nzb+1
    34303430!
     
    34403440
    34413441          w_comp(k) = w(k+1,j,i) + w(k,j,i)
    3442           flux_t(k) = w_comp(k) * rho_air(k+1) * (                            &
    3443                      ( 37.0_wp * ibit26 * adv_mom_5                           &
    3444                   +     7.0_wp * ibit25 * adv_mom_3                           &
    3445                   +              ibit24 * adv_mom_1                           &
    3446                      ) *                                                      &
    3447                                 ( w(k+1,j,i)   + w(k,j,i)    )                &
    3448               -      (  8.0_wp * ibit26 * adv_mom_5                           &
    3449                   +              ibit25 * adv_mom_3                           &
    3450                      ) *                                                      &
    3451                                 ( w(k_pp,j,i)  + w(k-1,j,i)  )                &
    3452               +      (           ibit26 * adv_mom_5                           &
    3453                      ) *                                                      &
    3454                                 ( w(k_ppp,j,i) + w(k_mm,j,i) )                &
     3442          flux_t(k) = w_comp(k) * rho_air(k+1) * (                             &
     3443                     ( 37.0_wp * ibit26 * adv_mom_5                            &
     3444                  +     7.0_wp * ibit25 * adv_mom_3                            &
     3445                  +              ibit24 * adv_mom_1                            &
     3446                     ) *                                                       &
     3447                                ( w(k+1,j,i)   + w(k,j,i)    )                 &
     3448              -      (  8.0_wp * ibit26 * adv_mom_5                            &
     3449                  +              ibit25 * adv_mom_3                            &
     3450                     ) *                                                       &
     3451                                ( w(k_pp,j,i)  + w(k-1,j,i)  )                 &
     3452              +      (           ibit26 * adv_mom_5                            &
     3453                     ) *                                                       &
     3454                                ( w(k_ppp,j,i) + w(k_mm,j,i) )                 &
    34553455                                                 )
    34563456
    3457           diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (                   &
    3458                      ( 10.0_wp * ibit26 * adv_mom_5                           &
    3459                   +     3.0_wp * ibit25 * adv_mom_3                           &
    3460                   +              ibit24 * adv_mom_1                           &
    3461                      ) *                                                      &
    3462                                 ( w(k+1,j,i)   - w(k,j,i)    )                &
    3463               -      (  5.0_wp * ibit26 * adv_mom_5                           &
    3464                   +              ibit25 * adv_mom_3                           &
    3465                      ) *                                                      &
    3466                                 ( w(k_pp,j,i)  - w(k-1,j,i)  )                &
    3467               +      (           ibit26 * adv_mom_5                           &
    3468                      ) *                                                      &
    3469                                 ( w(k_ppp,j,i) - w(k_mm,j,i) )                &
     3457          diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (                    &
     3458                     ( 10.0_wp * ibit26 * adv_mom_5                            &
     3459                  +     3.0_wp * ibit25 * adv_mom_3                            &
     3460                  +              ibit24 * adv_mom_1                            &
     3461                     ) *                                                       &
     3462                                ( w(k+1,j,i)   - w(k,j,i)    )                 &
     3463              -      (  5.0_wp * ibit26 * adv_mom_5                            &
     3464                  +              ibit25 * adv_mom_3                            &
     3465                     ) *                                                       &
     3466                                ( w(k_pp,j,i)  - w(k-1,j,i)  )                 &
     3467              +      (           ibit26 * adv_mom_5                            &
     3468                     ) *                                                       &
     3469                                ( w(k_ppp,j,i) - w(k_mm,j,i) )                 &
    34703470                                                          )
    34713471       ENDDO
    3472        
     3472
    34733473       DO  k = nzb+2, nzt-2
    3474        
     3474
    34753475          ibit26 = REAL( IBITS(advc_flags_m(k,j,i),26,1), KIND = wp )
    34763476          ibit25 = REAL( IBITS(advc_flags_m(k,j,i),25,1), KIND = wp )
     
    34783478
    34793479          w_comp(k) = w(k+1,j,i) + w(k,j,i)
    3480           flux_t(k) = w_comp(k) * rho_air(k+1) * (                            &
    3481                      ( 37.0_wp * ibit26 * adv_mom_5                           &
    3482                   +     7.0_wp * ibit25 * adv_mom_3                           &
    3483                   +              ibit24 * adv_mom_1                           &
    3484                      ) *                                                      &
    3485                                 ( w(k+1,j,i)  + w(k,j,i)   )                  &
    3486               -      (  8.0_wp * ibit26 * adv_mom_5                           &
    3487                   +              ibit25 * adv_mom_3                           &
    3488                      ) *                                                      &
    3489                                 ( w(k+2,j,i)  + w(k-1,j,i) )                  &
    3490               +      (           ibit26 * adv_mom_5                           &
    3491                      ) *                                                      &
    3492                                 ( w(k+3,j,i)  + w(k-2,j,i) )                  &
     3480          flux_t(k) = w_comp(k) * rho_air(k+1) * (                             &
     3481                     ( 37.0_wp * ibit26 * adv_mom_5                            &
     3482                  +     7.0_wp * ibit25 * adv_mom_3                            &
     3483                  +              ibit24 * adv_mom_1                            &
     3484                     ) *                                                       &
     3485                                ( w(k+1,j,i)  + w(k,j,i)   )                   &
     3486              -      (  8.0_wp * ibit26 * adv_mom_5                            &
     3487                  +              ibit25 * adv_mom_3                            &
     3488                     ) *                                                       &
     3489                                ( w(k+2,j,i)  + w(k-1,j,i) )                   &
     3490              +      (           ibit26 * adv_mom_5                            &
     3491                     ) *                                                       &
     3492                                ( w(k+3,j,i)  + w(k-2,j,i) )                   &
    34933493                                                 )
    34943494
    3495           diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (                   &
    3496                      ( 10.0_wp * ibit26 * adv_mom_5                           &
    3497                   +     3.0_wp * ibit25 * adv_mom_3                           &
    3498                   +              ibit24 * adv_mom_1                           &
    3499                      ) *                                                      &
    3500                                 ( w(k+1,j,i) - w(k,j,i)    )                  &
    3501               -      (  5.0_wp * ibit26 * adv_mom_5                           &
    3502                   +              ibit25 * adv_mom_3                           &
    3503                      ) *                                                      &
    3504                                 ( w(k+2,j,i) - w(k-1,j,i)  )                  &
    3505               +      (           ibit26 * adv_mom_5                           &
    3506                      ) *                                                      &
    3507                                 ( w(k+3,j,i) - w(k-2,j,i)  )                  &
     3495          diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (                    &
     3496                     ( 10.0_wp * ibit26 * adv_mom_5                            &
     3497                  +     3.0_wp * ibit25 * adv_mom_3                            &
     3498                  +              ibit24 * adv_mom_1                            &
     3499                     ) *                                                       &
     3500                                ( w(k+1,j,i) - w(k,j,i)    )                   &
     3501              -      (  5.0_wp * ibit26 * adv_mom_5                            &
     3502                  +              ibit25 * adv_mom_3                            &
     3503                     ) *                                                       &
     3504                                ( w(k+2,j,i) - w(k-1,j,i)  )                   &
     3505              +      (           ibit26 * adv_mom_5                            &
     3506                     ) *                                                       &
     3507                                ( w(k+3,j,i) - w(k-2,j,i)  )                   &
    35083508                                                          )
    35093509       ENDDO
    3510        
     3510
    35113511       DO  k = nzt-1, nzt-1
    35123512!
     
    35223522
    35233523          w_comp(k) = w(k+1,j,i) + w(k,j,i)
    3524           flux_t(k) = w_comp(k) * rho_air(k+1) * (                            &
    3525                      ( 37.0_wp * ibit26 * adv_mom_5                           &
    3526                   +     7.0_wp * ibit25 * adv_mom_3                           &
    3527                   +              ibit24 * adv_mom_1                           &
    3528                      ) *                                                      &
    3529                                 ( w(k+1,j,i)   + w(k,j,i)    )                &
    3530               -      (  8.0_wp * ibit26 * adv_mom_5                           &
    3531                   +              ibit25 * adv_mom_3                           &
    3532                      ) *                                                      &
    3533                                 ( w(k_pp,j,i)  + w(k-1,j,i)  )                &
    3534               +      (           ibit26 * adv_mom_5                           &
    3535                      ) *                                                      &
    3536                                 ( w(k_ppp,j,i) + w(k_mm,j,i) )                &
     3524          flux_t(k) = w_comp(k) * rho_air(k+1) * (                             &
     3525                     ( 37.0_wp * ibit26 * adv_mom_5                            &
     3526                  +     7.0_wp * ibit25 * adv_mom_3                            &
     3527                  +              ibit24 * adv_mom_1                            &
     3528                     ) *                                                       &
     3529                                ( w(k+1,j,i)   + w(k,j,i)    )                 &
     3530              -      (  8.0_wp * ibit26 * adv_mom_5                            &
     3531                  +              ibit25 * adv_mom_3                            &
     3532                     ) *                                                       &
     3533                                ( w(k_pp,j,i)  + w(k-1,j,i)  )                 &
     3534              +      (           ibit26 * adv_mom_5                            &
     3535                     ) *                                                       &
     3536                                ( w(k_ppp,j,i) + w(k_mm,j,i) )                 &
    35373537                                                 )
    35383538
    3539           diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (                   &
    3540                      ( 10.0_wp * ibit26 * adv_mom_5                           &
    3541                   +     3.0_wp * ibit25 * adv_mom_3                           &
    3542                   +              ibit24 * adv_mom_1                           &
    3543                      ) *                                                      &
    3544                                 ( w(k+1,j,i)   - w(k,j,i)    )                &
    3545               -      (  5.0_wp * ibit26 * adv_mom_5                           &
    3546                   +              ibit25 * adv_mom_3                           &
    3547                      ) *                                                      &
    3548                                 ( w(k_pp,j,i)  - w(k-1,j,i)  )                &
    3549               +      (           ibit26 * adv_mom_5                           &
    3550                      ) *                                                      &
    3551                                 ( w(k_ppp,j,i) - w(k_mm,j,i) )                &
     3539          diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (                    &
     3540                     ( 10.0_wp * ibit26 * adv_mom_5                            &
     3541                  +     3.0_wp * ibit25 * adv_mom_3                            &
     3542                  +              ibit24 * adv_mom_1                            &
     3543                     ) *                                                       &
     3544                                ( w(k+1,j,i)   - w(k,j,i)    )                 &
     3545              -      (  5.0_wp * ibit26 * adv_mom_5                            &
     3546                  +              ibit25 * adv_mom_3                            &
     3547                     ) *                                                       &
     3548                                ( w(k_pp,j,i)  - w(k-1,j,i)  )                 &
     3549              +      (           ibit26 * adv_mom_5                            &
     3550                     ) *                                                       &
     3551                                ( w(k_ppp,j,i) - w(k_mm,j,i) )                 &
    35523552                                                          )
    35533553       ENDDO
    3554        
    3555 !
    3556 !--    Set resolved/turbulent flux at model top to zero (w-level). Hint: The 
     3554
     3555!
     3556!--    Set resolved/turbulent flux at model top to zero (w-level). Hint: The
    35573557!--    flux at nzt is defined at the scalar grid point nzt+1. Therefore, the
    35583558!--    flux at nzt+1 is already outside of the model domain
     
    35603560       diss_t(nzt) = 0.0_wp
    35613561       w_comp(nzt) = 0.0_wp
    3562        
     3562
    35633563       flux_t(nzt+1) = 0.0_wp
    35643564       diss_t(nzt+1) = 0.0_wp
    35653565       w_comp(nzt+1) = 0.0_wp
    3566        
     3566
    35673567       DO  k = nzb+1, nzb_max_l
    35683568
    35693569          flux_d    = flux_t(k-1)
    35703570          diss_d    = diss_t(k-1)
    3571          
     3571
    35723572          ibit20 = REAL( IBITS(advc_flags_m(k,j,i),20,1), KIND = wp )
    35733573          ibit19 = REAL( IBITS(advc_flags_m(k,j,i),19,1), KIND = wp )
    35743574          ibit18 = REAL( IBITS(advc_flags_m(k,j,i),18,1), KIND = wp )
    3575          
     3575
    35763576          ibit23 = REAL( IBITS(advc_flags_m(k,j,i),23,1), KIND = wp )
    35773577          ibit22 = REAL( IBITS(advc_flags_m(k,j,i),22,1), KIND = wp )
    35783578          ibit21 = REAL( IBITS(advc_flags_m(k,j,i),21,1), KIND = wp )
    3579          
     3579
    35803580          ibit26 = REAL( IBITS(advc_flags_m(k,j,i),26,1), KIND = wp )
    35813581          ibit25 = REAL( IBITS(advc_flags_m(k,j,i),25,1), KIND = wp )
     
    35853585!--       correction is needed to overcome numerical instabilities introduced
    35863586!--       by a not sufficient reduction of divergences near topography.
    3587           div = ( ( ( u_comp(k) + gu ) * ( ibit18 + ibit19 + ibit20 )         &
    3588                   - ( u(k+1,j,i) + u(k,j,i)   )                               &
    3589                                     * (                                       &
    3590                      REAL( IBITS(advc_flags_m(k,j,i-1),18,1), KIND = wp )     &
    3591                    + REAL( IBITS(advc_flags_m(k,j,i-1),19,1), KIND = wp )     &
    3592                    + REAL( IBITS(advc_flags_m(k,j,i-1),20,1), KIND = wp )     &
    3593                                       )                                       &
    3594                   ) * ddx                                                     &
    3595               +   ( ( v_comp(k) + gv ) * ( ibit21 + ibit22 + ibit23 )         &
    3596                   - ( v(k+1,j,i) + v(k,j,i)   )                               &
    3597                                     * (                                       &
    3598                      REAL( IBITS(advc_flags_m(k,j-1,i),21,1), KIND = wp )     &
    3599                    + REAL( IBITS(advc_flags_m(k,j-1,i),22,1), KIND = wp )     &
    3600                    + REAL( IBITS(advc_flags_m(k,j-1,i),23,1), KIND = wp )     &
    3601                                       )                                       &
    3602                   ) * ddy                                                     &
    3603               +   ( w_comp(k)               * rho_air(k+1)                    &
    3604                                             * ( ibit24 + ibit25 + ibit26 )    &
    3605                 - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k)                      &
    3606                                     * (                                       &
    3607                      REAL( IBITS(advc_flags_m(k-1,j,i),24,1), KIND = wp )     &
    3608                    + REAL( IBITS(advc_flags_m(k-1,j,i),25,1), KIND = wp )     &
    3609                    + REAL( IBITS(advc_flags_m(k-1,j,i),26,1), KIND = wp )     &
    3610                                       )                                       &
    3611                   ) * drho_air_zw(k) * ddzu(k+1)                              &
    3612                 ) * 0.5_wp
    3613 
    3614           tend(k,j,i) = tend(k,j,i) - (                                       &
    3615                       ( flux_r(k) + diss_r(k)                                 &
    3616                     -   flux_l_w(k,j,tn) - diss_l_w(k,j,tn)   ) * ddx         &
    3617                     + ( flux_n(k) + diss_n(k)                                 &
    3618                     -   flux_s_w(k,tn) - diss_s_w(k,tn)       ) * ddy         &
    3619                     + ( ( flux_t(k) + diss_t(k) )                             &
    3620                     -   ( flux_d    + diss_d    )                             &
    3621                                               ) * drho_air_zw(k) * ddzu(k+1)  &
    3622                                       ) + div * w(k,j,i)
    3623 
    3624           flux_l_w(k,j,tn) = flux_r(k)
    3625           diss_l_w(k,j,tn) = diss_r(k)
    3626           flux_s_w(k,tn)   = flux_n(k)
    3627           diss_s_w(k,tn)   = diss_n(k)
    3628 !
    3629 !--       Statistical Evaluation of w'w'.
    3630           sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                          &
    3631                       + ( flux_t(k)                                           &
    3632                        * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                ) &
    3633                        / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )        ) &
    3634                         + diss_t(k)                                           &
    3635                        *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)           ) &
    3636                        / ( ABS( w_comp(k) ) + 1.0E-20_wp                    ) &
    3637                         ) *   weight_substep(intermediate_timestep_count)
    3638 
    3639        ENDDO
    3640        
    3641        DO  k = nzb_max_l+1, nzt-1
    3642 
    3643           flux_d    = flux_t(k-1)
    3644           diss_d    = diss_t(k-1)
    3645 !
    3646 !--       Calculate the divergence of the velocity field. A respective
    3647 !--       correction is needed to overcome numerical instabilities introduced
    3648 !--       by a not sufficient reduction of divergences near topography.
    3649           div = ( ( u_comp(k) + gu - ( u(k+1,j,i) + u(k,j,i)   ) ) * ddx       &
    3650               +   ( v_comp(k) + gv - ( v(k+1,j,i) + v(k,j,i)   ) ) * ddy       &
     3587          div = ( ( ( u_comp(k) + gu ) * ( ibit18 + ibit19 + ibit20 )          &
     3588                  - ( u(k+1,j,i) + u(k,j,i)   )                                &
     3589                                    * (                                        &
     3590                     REAL( IBITS(advc_flags_m(k,j,i-1),18,1), KIND = wp )      &
     3591                   + REAL( IBITS(advc_flags_m(k,j,i-1),19,1), KIND = wp )      &
     3592                   + REAL( IBITS(advc_flags_m(k,j,i-1),20,1), KIND = wp )      &
     3593                                      )                                        &
     3594                  ) * ddx                                                      &
     3595              +   ( ( v_comp(k) + gv ) * ( ibit21 + ibit22 + ibit23 )          &
     3596                  - ( v(k+1,j,i) + v(k,j,i)   )                                &
     3597                                    * (                                        &
     3598                     REAL( IBITS(advc_flags_m(k,j-1,i),21,1), KIND = wp )      &
     3599                   + REAL( IBITS(advc_flags_m(k,j-1,i),22,1), KIND = wp )      &
     3600                   + REAL( IBITS(advc_flags_m(k,j-1,i),23,1), KIND = wp )      &
     3601                                      )                                        &
     3602                  ) * ddy                                                      &
    36513603              +   ( w_comp(k)               * rho_air(k+1)                     &
    3652                 - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k)                       &
     3604                                            * ( ibit24 + ibit25 + ibit26 )     &
     3605                - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k)                       &
     3606                                    * (                                        &
     3607                     REAL( IBITS(advc_flags_m(k-1,j,i),24,1), KIND = wp )      &
     3608                   + REAL( IBITS(advc_flags_m(k-1,j,i),25,1), KIND = wp )      &
     3609                   + REAL( IBITS(advc_flags_m(k-1,j,i),26,1), KIND = wp )      &
     3610                                      )                                        &
    36533611                  ) * drho_air_zw(k) * ddzu(k+1)                               &
    36543612                ) * 0.5_wp
     
    36813639       ENDDO
    36823640
     3641       DO  k = nzb_max_l+1, nzt-1
     3642
     3643          flux_d    = flux_t(k-1)
     3644          diss_d    = diss_t(k-1)
     3645!
     3646!--       Calculate the divergence of the velocity field. A respective
     3647!--       correction is needed to overcome numerical instabilities introduced
     3648!--       by a not sufficient reduction of divergences near topography.
     3649          div = ( ( u_comp(k) + gu - ( u(k+1,j,i) + u(k,j,i)   ) ) * ddx       &
     3650              +   ( v_comp(k) + gv - ( v(k+1,j,i) + v(k,j,i)   ) ) * ddy       &
     3651              +   ( w_comp(k)               * rho_air(k+1)                     &
     3652                - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k)                       &
     3653                  ) * drho_air_zw(k) * ddzu(k+1)                               &
     3654                ) * 0.5_wp
     3655
     3656          tend(k,j,i) = tend(k,j,i) - (                                        &
     3657                      ( flux_r(k) + diss_r(k)                                  &
     3658                    -   flux_l_w(k,j,tn) - diss_l_w(k,j,tn)   ) * ddx          &
     3659                    + ( flux_n(k) + diss_n(k)                                  &
     3660                    -   flux_s_w(k,tn) - diss_s_w(k,tn)       ) * ddy          &
     3661                    + ( ( flux_t(k) + diss_t(k) )                              &
     3662                    -   ( flux_d    + diss_d    )                              &
     3663                                              ) * drho_air_zw(k) * ddzu(k+1)   &
     3664                                      ) + div * w(k,j,i)
     3665
     3666          flux_l_w(k,j,tn) = flux_r(k)
     3667          diss_l_w(k,j,tn) = diss_r(k)
     3668          flux_s_w(k,tn)   = flux_n(k)
     3669          diss_s_w(k,tn)   = diss_n(k)
     3670!
     3671!--       Statistical Evaluation of w'w'.
     3672          sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                           &
     3673                      + ( flux_t(k)                                            &
     3674                       * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                )  &
     3675                       / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )        )  &
     3676                        + diss_t(k)                                            &
     3677                       *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)           )  &
     3678                       / ( ABS( w_comp(k) ) + 1.0E-20_wp                    )  &
     3679                        ) *   weight_substep(intermediate_timestep_count)
     3680
     3681       ENDDO
     3682
    36833683    END SUBROUTINE advec_w_ws_ij
    3684    
     3684
    36853685
    36863686!------------------------------------------------------------------------------!
     
    36943694
    36953695
    3696        CHARACTER (LEN = *), INTENT(IN)    ::  sk_char !< string identifier, used for assign fluxes to the correct dimension in the analysis array
    3697        INTEGER(iwp) ::  sk_num !< integer identifier, used for assign fluxes to the correct dimension in the analysis array
    3698        
    3699        INTEGER(iwp) ::  i          !< grid index along x-direction
    3700        INTEGER(iwp) ::  j          !< grid index along y-direction
    3701        INTEGER(iwp) ::  k          !< grid index along z-direction
    3702        INTEGER(iwp) ::  k_mm       !< k-2 index in disretization, can be modified to avoid segmentation faults
    3703        INTEGER(iwp) ::  k_pp       !< k+2 index in disretization, can be modified to avoid segmentation faults
    3704        INTEGER(iwp) ::  k_ppp      !< k+3 index in disretization, can be modified to avoid segmentation faults
    3705        INTEGER(iwp) ::  nzb_max_l  !< index indicating upper bound for order degradation of horizontal advection terms
    3706        INTEGER(iwp) ::  tn = 0     !< number of OpenMP thread
    3707        
     3696       CHARACTER (LEN = *), INTENT(IN) ::  sk_char !< string identifier, used for assign fluxes
     3697                                                   !< to the correct dimension in the analysis array
     3698
     3699       INTEGER(iwp) ::  i         !< grid index along x-direction
     3700       INTEGER(iwp) ::  j         !< grid index along y-direction
     3701       INTEGER(iwp) ::  k         !< grid index along z-direction
     3702       INTEGER(iwp) ::  k_mm      !< k-2 index in disretization, can be modified to avoid segmentation faults
     3703       INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
     3704       INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
     3705       INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
     3706       INTEGER(iwp) ::  sk_num    !< integer identifier, used for assign fluxes to the correct dimension in the analysis array
     3707       INTEGER(iwp) ::  tn = 0    !< number of OpenMP thread
     3708
    37083709       INTEGER(iwp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::   &
    37093710                                                  advc_flag !< flag array to control order of scalar advection
    3710                                                  
    3711        LOGICAL ::  non_cyclic_l    !< flag that indicates non-cyclic boundary on the left
    3712        LOGICAL ::  non_cyclic_n    !< flag that indicates non-cyclic boundary on the north
    3713        LOGICAL ::  non_cyclic_r    !< flag that indicates non-cyclic boundary on the right
    3714        LOGICAL ::  non_cyclic_s    !< flag that indicates non-cyclic boundary on the south 
    3715 !       
    3716 !--    sk is an array from parameter list. It should not be a pointer, because
    3717 !--    in that case the compiler can not assume a stride 1 and cannot perform
    3718 !--    a strided one vector load. Adding the CONTIGUOUS keyword makes things
    3719 !--    even worse, because the compiler cannot assume strided one in the
    3720 !--    caller side.
    3721        REAL(wp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<  advected scalar
    3722 
    3723        REAL(wp) ::  ibit0  !< flag indicating 1st-order scheme along x-direction
    3724        REAL(wp) ::  ibit1  !< flag indicating 3rd-order scheme along x-direction
    3725        REAL(wp) ::  ibit2  !< flag indicating 5th-order scheme along x-direction
     3711
     3712       LOGICAL  ::  non_cyclic_l    !< flag that indicates non-cyclic boundary on the left
     3713       LOGICAL  ::  non_cyclic_n    !< flag that indicates non-cyclic boundary on the north
     3714       LOGICAL  ::  non_cyclic_r    !< flag that indicates non-cyclic boundary on the right
     3715       LOGICAL  ::  non_cyclic_s    !< flag that indicates non-cyclic boundary on the south
     3716
     3717       REAL(wp) ::  diss_d        !< artificial dissipation term at grid box bottom
     3718       REAL(wp) ::  div           !< velocity diverence on scalar grid
     3719       REAL(wp) ::  flux_d        !< 6th-order flux at grid box bottom
     3720       REAL(wp) ::  ibit0         !< flag indicating 1st-order scheme along x-direction
     3721       REAL(wp) ::  ibit1         !< flag indicating 3rd-order scheme along x-direction
     3722       REAL(wp) ::  ibit2         !< flag indicating 5th-order scheme along x-direction
     3723       REAL(wp) ::  ibit3         !< flag indicating 1st-order scheme along y-direction
     3724       REAL(wp) ::  ibit4         !< flag indicating 3rd-order scheme along y-direction
     3725       REAL(wp) ::  ibit5         !< flag indicating 5th-order scheme along y-direction
     3726       REAL(wp) ::  ibit6         !< flag indicating 1st-order scheme along z-direction
     3727       REAL(wp) ::  ibit7         !< flag indicating 3rd-order scheme along z-direction
     3728       REAL(wp) ::  ibit8         !< flag indicating 5th-order scheme along z-direction
    37263729#ifdef _OPENACC
    37273730       REAL(wp) ::  ibit0_l  !< flag indicating 1st-order scheme along x-direction
    37283731       REAL(wp) ::  ibit1_l  !< flag indicating 3rd-order scheme along x-direction
    37293732       REAL(wp) ::  ibit2_l  !< flag indicating 5th-order scheme along x-direction
    3730 #endif
    3731        REAL(wp) ::  ibit3  !< flag indicating 1st-order scheme along y-direction
    3732        REAL(wp) ::  ibit4  !< flag indicating 3rd-order scheme along y-direction
    3733        REAL(wp) ::  ibit5  !< flag indicating 5th-order scheme along y-direction
    3734 #ifdef _OPENACC
    37353733       REAL(wp) ::  ibit3_s  !< flag indicating 1st-order scheme along y-direction
    37363734       REAL(wp) ::  ibit4_s  !< flag indicating 3rd-order scheme along y-direction
    37373735       REAL(wp) ::  ibit5_s  !< flag indicating 5th-order scheme along y-direction
    37383736#endif
    3739        REAL(wp) ::  ibit6  !< flag indicating 1st-order scheme along z-direction
    3740        REAL(wp) ::  ibit7  !< flag indicating 3rd-order scheme along z-direction
    3741        REAL(wp) ::  ibit8  !< flag indicating 5th-order scheme along z-direction
    3742        REAL(wp) ::  diss_d !< artificial dissipation term at grid box bottom
    3743        REAL(wp) ::  div    !< diverence on scalar grid
    3744        REAL(wp) ::  flux_d !< 6th-order flux at grid box bottom
    3745        REAL(wp) ::  u_comp !< advection velocity along x-direction
     3737       REAL(wp) ::  u_comp        !< advection velocity along x-direction
     3738       REAL(wp) ::  v_comp        !< advection velocity along y-direction
    37463739#ifdef _OPENACC
    37473740       REAL(wp) ::  u_comp_l !< advection velocity along x-direction
    3748 #endif
    3749        REAL(wp) ::  v_comp !< advection velocity along y-direction
    3750 #ifdef _OPENACC
    37513741       REAL(wp) ::  v_comp_s !< advection velocity along y-direction
    37523742#endif
    3753        
    3754        REAL(wp) ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
    3755        REAL(wp) ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
    3756        REAL(wp) ::  diss_t !< discretized artificial dissipation at rightward-side of the grid box
    3757        REAL(wp) ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
    3758        REAL(wp) ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
    3759        REAL(wp) ::  flux_t !< discretized 6th-order flux at rightward-side of the grid box
    3760        
    3761        REAL(wp) ::  diss_s !< discretized artificial dissipation term at southward-side of the grid box
    3762        REAL(wp) ::  flux_s !< discretized 6th-order flux at northward-side of the grid box
    3763 #ifndef _OPENACC
    3764        REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local !< discretized artificial dissipation term at southward-side of the grid box
    3765        REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local !< discretized 6th-order flux at northward-side of the grid box
    3766 #endif
    3767        
    3768        REAL(wp) ::  diss_l !< discretized artificial dissipation term at leftward-side of the grid box
    3769        REAL(wp) ::  flux_l !< discretized 6th-order flux at leftward-side of the grid box
    3770 #ifndef _OPENACC
    3771        REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local !< discretized artificial dissipation term at leftward-side of the grid box
    3772        REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local !< discretized 6th-order flux at leftward-side of the grid box
    3773 #endif
    3774        
    3775 !
    3776 !--    Set local version of nzb_max. At non-cyclic boundaries the order of the
    3777 !--    advection need to be degraded near the boundary. Please note, in contrast
    3778 !--    to the cache-optimized routines, nzb_max_l is set constantly for the
    3779 !--    entire subdomain, in order to avoid unsymmetric loops which might be
    3780 !--    an issue for GPUs.
    3781        IF( non_cyclic_l  .OR.  non_cyclic_r  .OR.                             &
    3782            non_cyclic_s  .OR.  non_cyclic_n )  THEN
    3783           nzb_max_l = nzt
    3784        ELSE
    3785           nzb_max_l = nzb_max
    3786        END IF
    3787        
     3743!
     3744!--    sk is an array from parameter list. It should not be a pointer, because
     3745!--    in that case the compiler can not assume a stride 1 and cannot perform
     3746!--    a strided one vector load. Adding the CONTIGUOUS keyword makes things
     3747!--    even worse, because the compiler cannot assume strided one in the
     3748!--    caller side.
     3749       REAL(wp), INTENT(IN),DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<  advected scalar
     3750
     3751       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_n     !< discretized artificial dissipation at northward-side
     3752       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_r     !< discretized artificial dissipation at rightward-side
     3753       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_t     !< discretized artificial dissipation at top of the grid box
     3754       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_n     !< discretized 6th-order flux at northward-side of the grid box
     3755       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_r     !< discretized 6th-order flux at rightward-side of the grid box
     3756       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_t     !< discretized 6th-order flux at top of the grid box
     3757
     3758       REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_diss_y_local !< discretized artificial dissipation at southward-side
     3759       REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_flux_y_local !< discretized 6th-order flux at northward-side
     3760
     3761       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_diss_x_local !< discretized artificial dissipation at leftward-side
     3762       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_flux_x_local !< discretized 6th-order flux at leftward-side
     3763
     3764       CALL cpu_log( log_point_s(49), 'advec_s_ws', 'start' )
     3765
    37883766       SELECT CASE ( sk_char )
    37893767
     
    38113789       END SELECT
    38123790
    3813 #ifndef _OPENACC
    3814 !
    3815 !--    Compute the fluxes for the whole left boundary of the processor domain.
    3816        i = nxl
    3817        DO  j = nys, nyn
    3818 
    3819           DO  k = nzb+1, nzb_max_l
    3820 
    3821              ibit2 = REAL( IBITS(advc_flag(k,j,i-1),2,1), KIND = wp )
    3822              ibit1 = REAL( IBITS(advc_flag(k,j,i-1),1,1), KIND = wp )
    3823              ibit0 = REAL( IBITS(advc_flag(k,j,i-1),0,1), KIND = wp )
    3824 
    3825              u_comp                 = u(k,j,i) - u_gtrans + u_stokes_zu(k)
    3826              swap_flux_x_local(k,j) = u_comp * (                              &
    3827                                              ( 37.0_wp * ibit2 * adv_sca_5    &
    3828                                           +     7.0_wp * ibit1 * adv_sca_3    &
    3829                                           +              ibit0 * adv_sca_1    &
    3830                                              ) *                              &
    3831                                           ( sk(k,j,i)   + sk(k,j,i-1)    )    &
    3832                                       -      (  8.0_wp * ibit2 * adv_sca_5    &
    3833                                           +              ibit1 * adv_sca_3    &
    3834                                              ) *                              &
    3835                                           ( sk(k,j,i+1) + sk(k,j,i-2)    )    &
    3836                                       +      (           ibit2 * adv_sca_5    &
    3837                                              ) *                              &
    3838                                           ( sk(k,j,i+2) + sk(k,j,i-3)    )    &
    3839                                                )
    3840 
    3841               swap_diss_x_local(k,j) = -ABS( u_comp ) * (                     &
    3842                                              ( 10.0_wp * ibit2 * adv_sca_5    &
    3843                                           +     3.0_wp * ibit1 * adv_sca_3    &
    3844                                           +              ibit0 * adv_sca_1    &
    3845                                              ) *                              &
    3846                                           ( sk(k,j,i)   - sk(k,j,i-1) )       &
    3847                                       -      (  5.0_wp * ibit2 * adv_sca_5    &
    3848                                           +              ibit1 * adv_sca_3    &
    3849                                              ) *                              &
    3850                                          ( sk(k,j,i+1) - sk(k,j,i-2)  )       &
    3851                                       +      (           ibit2 * adv_sca_5    &
    3852                                              ) *                              &
    3853                                           ( sk(k,j,i+2) - sk(k,j,i-3) )       &
    3854                                                         )
    3855 
    3856           ENDDO
    3857 
    3858           DO  k = nzb_max_l+1, nzt
    3859 
    3860              u_comp                 = u(k,j,i) - u_gtrans + u_stokes_zu(k)
    3861              swap_flux_x_local(k,j) = u_comp * (                              &
    3862                                       37.0_wp * ( sk(k,j,i)   + sk(k,j,i-1) ) &
    3863                                     -  8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) ) &
    3864                                     +           ( sk(k,j,i+2) + sk(k,j,i-3) ) &
    3865                                                ) * adv_sca_5
    3866 
    3867              swap_diss_x_local(k,j) = -ABS( u_comp ) * (                      &
    3868                                       10.0_wp * ( sk(k,j,i)   - sk(k,j,i-1) ) &
    3869                                     -  5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) ) &
    3870                                     +           ( sk(k,j,i+2) - sk(k,j,i-3) ) &
    3871                                                        ) * adv_sca_5
    3872 
    3873           ENDDO
    3874 
    3875        ENDDO
    3876 #endif
    3877 
    38783791       !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, sk_num) &
    38793792       !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) &
     
    38823795       !$ACC PRIVATE(ibit3_s, ibit4_s, ibit5_s) &
    38833796       !$ACC PRIVATE(ibit6, ibit7, ibit8) &
    3884        !$ACC PRIVATE(flux_r, diss_r, flux_l, diss_l) &
    3885        !$ACC PRIVATE(flux_n, diss_n, flux_s, diss_s) &
     3797       !$ACC PRIVATE(flux_r, diss_r) &
     3798       !$ACC PRIVATE(flux_n, diss_n) &
     3799       !$ACC PRIVATE(swap_diss_y_local, swap_flux_y_local) &
    38863800       !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) &
    38873801       !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s) &
     
    38903804       !$ACC PRESENT(drho_air, rho_air_zw, ddzw) &
    38913805       !$ACC PRESENT(tend) &
    3892        !$ACC PRESENT(hom(nzb+1:nzb_max_l,1,1:3,0)) &
     3806       !$ACC PRESENT(hom(:,1,1:3,0)) &
    38933807       !$ACC PRESENT(weight_substep(intermediate_timestep_count)) &
    38943808       !$ACC PRESENT(sums_wspts_ws_l, sums_wssas_ws_l) &
     
    38983812       !$ACC PRESENT(sums_salsa_ws_l)
    38993813       DO  i = nxl, nxr
    3900 
     3814          DO  j = nys, nyn
     3815!
     3816!--          Used local modified copy of nzb_max (used to degrade order of
     3817!--          discretization) at non-cyclic boundaries. Modify only at relevant points
     3818!--          instead of the entire subdomain. This should lead to better
     3819!--          load balance between boundary and non-boundary PEs.
     3820             IF( non_cyclic_l  .AND.  i <= nxl + 2  .OR.                       &
     3821                 non_cyclic_r  .AND.  i >= nxr - 2  .OR.                       &
     3822                 non_cyclic_s  .AND.  j <= nys + 2  .OR.                       &
     3823                 non_cyclic_n  .AND.  j >= nyn - 2 )  THEN
     3824                nzb_max_l = nzt
     3825             ELSE
     3826                nzb_max_l = nzb_max
     3827             END IF
    39013828#ifndef _OPENACC
    3902           j = nys
    3903           DO  k = nzb+1, nzb_max_l
    3904 
    3905              ibit5 = REAL( IBITS(advc_flag(k,j-1,i),5,1), KIND = wp )
    3906              ibit4 = REAL( IBITS(advc_flag(k,j-1,i),4,1), KIND = wp )
    3907              ibit3 = REAL( IBITS(advc_flag(k,j-1,i),3,1), KIND = wp )
    3908 
    3909              v_comp               = v(k,j,i) - v_gtrans + v_stokes_zu(k)
    3910              swap_flux_y_local(k) = v_comp * (                                &
    3911                                              ( 37.0_wp * ibit5 * adv_sca_5    &
    3912                                           +     7.0_wp * ibit4 * adv_sca_3    &
    3913                                           +              ibit3 * adv_sca_1    &
    3914                                              ) *                              &
    3915                                          ( sk(k,j,i)  + sk(k,j-1,i)     )     &
    3916                                        -     (  8.0_wp * ibit5 * adv_sca_5    &
    3917                                           +              ibit4 * adv_sca_3    &
    3918                                               ) *                             &
    3919                                          ( sk(k,j+1,i) + sk(k,j-2,i)    )     &
    3920                                       +      (           ibit5 * adv_sca_5    &
    3921                                              ) *                              &
    3922                                         ( sk(k,j+2,i) + sk(k,j-3,i)     )     &
    3923                                              )
    3924 
    3925              swap_diss_y_local(k) = -ABS( v_comp ) * (                        &
    3926                                              ( 10.0_wp * ibit5 * adv_sca_5    &
    3927                                           +     3.0_wp * ibit4 * adv_sca_3    &
    3928                                           +              ibit3 * adv_sca_1    &
    3929                                              ) *                              &
    3930                                           ( sk(k,j,i)   - sk(k,j-1,i)    )    &
    3931                                       -      (  5.0_wp * ibit5 * adv_sca_5    &
    3932                                           +              ibit4 * adv_sca_3    &
    3933                                              ) *                              &
    3934                                           ( sk(k,j+1,i) - sk(k,j-2,i)    )    &
    3935                                       +      (           ibit5 * adv_sca_5    &
    3936                                              ) *                              &
    3937                                           ( sk(k,j+2,i) - sk(k,j-3,i)    )    &
    3938                                                      )
    3939 
    3940           ENDDO
    3941 !
    3942 !--       Above to the top of the highest topography. No degradation necessary.
    3943           DO  k = nzb_max_l+1, nzt
    3944 
    3945              v_comp               = v(k,j,i) - v_gtrans + v_stokes_zu(k)
    3946              swap_flux_y_local(k) = v_comp * (                               &
    3947                                     37.0_wp * ( sk(k,j,i)   + sk(k,j-1,i) )  &
    3948                                   -  8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) )  &
    3949                                   +           ( sk(k,j+2,i) + sk(k,j-3,i) )  &
    3950                                              ) * adv_sca_5
    3951              swap_diss_y_local(k) = -ABS( v_comp ) * (                       &
    3952                                     10.0_wp * ( sk(k,j,i)   - sk(k,j-1,i) )  &
    3953                                   -  5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) )  &
    3954                                   +             sk(k,j+2,i) - sk(k,j-3,i)    &
     3829!
     3830!--          Compute leftside fluxes of the respective PE bounds.
     3831             IF ( i == nxl )  THEN
     3832
     3833                DO  k = nzb+1, nzb_max_l
     3834
     3835                   ibit2 = REAL( IBITS(advc_flag(k,j,i-1),2,1), KIND = wp )
     3836                   ibit1 = REAL( IBITS(advc_flag(k,j,i-1),1,1), KIND = wp )
     3837                   ibit0 = REAL( IBITS(advc_flag(k,j,i-1),0,1), KIND = wp )
     3838
     3839                   u_comp                    = u(k,j,i) - u_gtrans + u_stokes_zu(k)
     3840                   swap_flux_x_local(k,j,tn) = u_comp * (                      &
     3841                                               ( 37.0_wp * ibit2 * adv_sca_5   &
     3842                                            +     7.0_wp * ibit1 * adv_sca_3   &
     3843                                            +              ibit0 * adv_sca_1   &
     3844                                               ) *                             &
     3845                                            ( sk(k,j,i)   + sk(k,j,i-1)    )   &
     3846                                        -      (  8.0_wp * ibit2 * adv_sca_5   &
     3847                                            +              ibit1 * adv_sca_3   &
     3848                                               ) *                             &
     3849                                            ( sk(k,j,i+1) + sk(k,j,i-2)    )   &
     3850                                        +      (           ibit2 * adv_sca_5   &
     3851                                               ) *                             &
     3852                                               ( sk(k,j,i+2) + sk(k,j,i-3)    )&
     3853                                                        )
     3854
     3855                   swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * (              &
     3856                                                ( 10.0_wp * ibit2 * adv_sca_5  &
     3857                                             +     3.0_wp * ibit1 * adv_sca_3  &
     3858                                             +              ibit0 * adv_sca_1  &
     3859                                                ) *                            &
     3860                                             ( sk(k,j,i)   - sk(k,j,i-1)    )  &
     3861                                         -      (  5.0_wp * ibit2 * adv_sca_5  &
     3862                                             +              ibit1 * adv_sca_3  &
     3863                                                ) *                            &
     3864                                             ( sk(k,j,i+1) - sk(k,j,i-2)    )  &
     3865                                         +      (           ibit2 * adv_sca_5  &
     3866                                                ) *                            &
     3867                                             ( sk(k,j,i+2) - sk(k,j,i-3)    )  &
     3868                                                                )
     3869
     3870                ENDDO
     3871
     3872                DO  k = nzb_max_l+1, nzt
     3873
     3874                   u_comp                    = u(k,j,i) - u_gtrans + u_stokes_zu(k)
     3875                   swap_flux_x_local(k,j,tn) = u_comp * (                      &
     3876                                        37.0_wp * ( sk(k,j,i)   + sk(k,j,i-1) )&
     3877                                      -  8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) )&
     3878                                      +           ( sk(k,j,i+2) + sk(k,j,i-3) )&
     3879                                                        ) * adv_sca_5
     3880
     3881                   swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * (              &
     3882                                        10.0_wp * ( sk(k,j,i)   - sk(k,j,i-1) )&
     3883                                      -  5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) )&
     3884                                      +           ( sk(k,j,i+2) - sk(k,j,i-3) )&
     3885                                                                ) * adv_sca_5
     3886
     3887                ENDDO
     3888
     3889             ENDIF
     3890!
     3891!--          Compute southside fluxes of the respective PE bounds.
     3892             IF ( j == nys )  THEN
     3893!
     3894!--             Up to the top of the highest topography.
     3895                DO  k = nzb+1, nzb_max_l
     3896
     3897                   ibit5 = REAL( IBITS(advc_flag(k,j-1,i),5,1), KIND = wp )
     3898                   ibit4 = REAL( IBITS(advc_flag(k,j-1,i),4,1), KIND = wp )
     3899                   ibit3 = REAL( IBITS(advc_flag(k,j-1,i),3,1), KIND = wp )
     3900
     3901                   v_comp                  = v(k,j,i) - v_gtrans + v_stokes_zu(k)
     3902                   swap_flux_y_local(k,tn) = v_comp *         (                &
     3903                                                ( 37.0_wp * ibit5 * adv_sca_5  &
     3904                                             +     7.0_wp * ibit4 * adv_sca_3  &
     3905                                             +              ibit3 * adv_sca_1  &
     3906                                                ) *                            &
     3907                                            ( sk(k,j,i)  + sk(k,j-1,i)     )   &
     3908                                          -     (  8.0_wp * ibit5 * adv_sca_5  &
     3909                                             +              ibit4 * adv_sca_3  &
     3910                                                 ) *                           &
     3911                                            ( sk(k,j+1,i) + sk(k,j-2,i)    )   &
     3912                                          +     (           ibit5 * adv_sca_5  &
     3913                                                ) *                            &
     3914                                            ( sk(k,j+2,i) + sk(k,j-3,i)    )   &
     3915                                                              )
     3916
     3917                   swap_diss_y_local(k,tn) = -ABS( v_comp ) * (                &
     3918                                                ( 10.0_wp * ibit5 * adv_sca_5  &
     3919                                             +     3.0_wp * ibit4 * adv_sca_3  &
     3920                                             +              ibit3 * adv_sca_1  &
     3921                                                ) *                            &
     3922                                             ( sk(k,j,i)   - sk(k,j-1,i)  )    &
     3923                                         -      (  5.0_wp * ibit5 * adv_sca_5  &
     3924                                             +              ibit4 * adv_sca_3  &
     3925                                             ) *                               &
     3926                                             ( sk(k,j+1,i) - sk(k,j-2,i)  )    &
     3927                                         +      (           ibit5 * adv_sca_5  &
     3928                                                ) *                            &
     3929                                             ( sk(k,j+2,i) - sk(k,j-3,i)  )    &
     3930                                                              )
     3931
     3932                ENDDO
     3933!
     3934!--             Above to the top of the highest topography. No degradation necessary.
     3935                DO  k = nzb_max_l+1, nzt
     3936
     3937                   v_comp                  = v(k,j,i) - v_gtrans + v_stokes_zu(k)
     3938                   swap_flux_y_local(k,tn) = v_comp * (                        &
     3939                                     37.0_wp * ( sk(k,j,i)   + sk(k,j-1,i) )   &
     3940                                   -  8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) )   &
     3941                                   +           ( sk(k,j+2,i) + sk(k,j-3,i) )   &
    39553942                                                      ) * adv_sca_5
    3956 
    3957           ENDDO
     3943                   swap_diss_y_local(k,tn) = -ABS( v_comp ) * (                &
     3944                                     10.0_wp * ( sk(k,j,i)   - sk(k,j-1,i) )   &
     3945                                   -  5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) )   &
     3946                                   +             sk(k,j+2,i) - sk(k,j-3,i)     &
     3947                                                         ) * adv_sca_5
     3948
     3949                ENDDO
     3950
     3951             ENDIF
    39583952#endif
    3959 
    3960           DO  j = nys, nyn
    3961 
    3962              flux_d    = 0.0_wp
    3963              diss_d    = 0.0_wp
    3964 
     3953!
     3954!--          Now compute the fluxes and tendency terms for the horizontal and
     3955!--          vertical parts up to the top of the highest topography.
    39653956             DO  k = nzb+1, nzb_max_l
    3966 
     3957!
     3958!--             Note: It is faster to conduct all multiplications explicitly, e.g.
     3959!--             * adv_sca_5 ... than to determine a factor and multiplicate the
     3960!--             flux at the end.
    39673961                ibit2 = REAL( IBITS(advc_flag(k,j,i),2,1), KIND = wp )
    39683962                ibit1 = REAL( IBITS(advc_flag(k,j,i),1,1), KIND = wp )
    39693963                ibit0 = REAL( IBITS(advc_flag(k,j,i),0,1), KIND = wp )
    39703964
    3971                 u_comp = u(k,j,i+1) - u_gtrans + u_stokes_zu(k)
    3972                 flux_r = u_comp * (                                           &
    3973                           ( 37.0_wp * ibit2 * adv_sca_5                       &
    3974                       +      7.0_wp * ibit1 * adv_sca_3                       &
    3975                       +               ibit0 * adv_sca_1                       &
    3976                           ) *                                                 &
    3977                              ( sk(k,j,i+1) + sk(k,j,i)   )                    &
    3978                    -      (  8.0_wp * ibit2 * adv_sca_5                       &
    3979                        +              ibit1 * adv_sca_3                       &
    3980                           ) *                                                 &
    3981                              ( sk(k,j,i+2) + sk(k,j,i-1) )                    &
    3982                    +      (           ibit2 * adv_sca_5                       &
    3983                           ) *                                                 &
    3984                              ( sk(k,j,i+3) + sk(k,j,i-2) )                    &
     3965                u_comp    = u(k,j,i+1) - u_gtrans + u_stokes_zu(k)
     3966                flux_r(k) = u_comp * (                                         &
     3967                           ( 37.0_wp * ibit2 * adv_sca_5                       &
     3968                        +     7.0_wp * ibit1 * adv_sca_3                       &
     3969                        +              ibit0 * adv_sca_1                       &
     3970                           ) *                                                 &
     3971                                   ( sk(k,j,i+1) + sk(k,j,i)   )               &
     3972                    -      (  8.0_wp * ibit2 * adv_sca_5                       &
     3973                        +              ibit1 * adv_sca_3                       &
     3974                           ) *                                                 &
     3975                                   ( sk(k,j,i+2) + sk(k,j,i-1) )               &
     3976                    +      (           ibit2 * adv_sca_5                       &
     3977                           ) *                                                 &
     3978                                   ( sk(k,j,i+3) + sk(k,j,i-2) )               &
    39853979                                     )
    39863980
    3987                 diss_r = -ABS( u_comp ) * (                                   &
    3988                           ( 10.0_wp * ibit2 * adv_sca_5                       &
    3989                        +     3.0_wp * ibit1 * adv_sca_3                       &
    3990                        +              ibit0 * adv_sca_1                       &
    3991                           ) *                                                 &
    3992                              ( sk(k,j,i+1) - sk(k,j,i)   )                    &
    3993                    -      (  5.0_wp * ibit2 * adv_sca_5                       &
    3994                        +              ibit1 * adv_sca_3                       &
    3995                           ) *                                                 &
    3996                              ( sk(k,j,i+2) - sk(k,j,i-1) )                    &
    3997                    +      (           ibit2 * adv_sca_5                       &
    3998                           ) *                                                 &
    3999                              ( sk(k,j,i+3) - sk(k,j,i-2) )                    &
     3981                diss_r(k) = -ABS( u_comp ) * (                                 &
     3982                           ( 10.0_wp * ibit2 * adv_sca_5                       &
     3983                        +     3.0_wp * ibit1 * adv_sca_3                       &
     3984                        +              ibit0 * adv_sca_1                       &
     3985                           ) *                                                 &
     3986                                   ( sk(k,j,i+1) - sk(k,j,i)  )                &
     3987                    -      (  5.0_wp * ibit2 * adv_sca_5                       &
     3988                        +              ibit1 * adv_sca_3                       &
     3989                           ) *                                                 &
     3990                                   ( sk(k,j,i+2) - sk(k,j,i-1) )               &
     3991                    +      (           ibit2 * adv_sca_5                       &
     3992                           ) *                                                 &
     3993                                   ( sk(k,j,i+3) - sk(k,j,i-2) )               &
    40003994                                             )
    4001 
    40023995#ifdef _OPENACC
    40033996!
     
    40084001
    40094002                u_comp_l = u(k,j,i) - u_gtrans + u_stokes_zu(k)
    4010                 flux_l = u_comp_l * (                                         &
    4011                                              ( 37.0_wp * ibit2_l * adv_sca_5  &
    4012                                           +     7.0_wp * ibit1_l * adv_sca_3  &
    4013                                           +              ibit0_l * adv_sca_1  &
    4014                                              ) *                              &
    4015                                           ( sk(k,j,i)   + sk(k,j,i-1)    )    &
    4016                                       -      (  8.0_wp * ibit2_l * adv_sca_5  &
    4017                                           +              ibit1_l * adv_sca_3  &
    4018                                              ) *                              &
    4019                                           ( sk(k,j,i+1) + sk(k,j,i-2)    )    &
    4020                                       +      (           ibit2_l * adv_sca_5  &
    4021                                              ) *                              &
    4022                                           ( sk(k,j,i+2) + sk(k,j,i-3)    )    &
    4023                                                )
    4024 
    4025                  diss_l = -ABS( u_comp_l ) * (                                &
    4026                                              ( 10.0_wp * ibit2_l * adv_sca_5  &
    4027                                           +     3.0_wp * ibit1_l * adv_sca_3  &
    4028                                           +              ibit0_l * adv_sca_1  &
    4029                                              ) *                              &
    4030                                           ( sk(k,j,i)   - sk(k,j,i-1) )       &
    4031                                       -      (  5.0_wp * ibit2_l * adv_sca_5  &
    4032                                           +              ibit1_l * adv_sca_3  &
    4033                                              ) *                              &
    4034                                          ( sk(k,j,i+1) - sk(k,j,i-2)  )       &
    4035                                       +      (           ibit2_l * adv_sca_5  &
    4036                                              ) *                              &
    4037                                           ( sk(k,j,i+2) - sk(k,j,i-3) )       &
    4038                                                         )
    4039 #else
    4040                 flux_l = swap_flux_x_local(k,j)
    4041                 diss_l = swap_diss_x_local(k,j)
     4003                swap_flux_x_local(k,j,tn) = u_comp_l * (                       &
     4004                                             ( 37.0_wp * ibit2_l * adv_sca_5   &
     4005                                          +     7.0_wp * ibit1_l * adv_sca_3   &
     4006                                          +              ibit0_l * adv_sca_1   &
     4007                                             ) *                               &
     4008                                          ( sk(k,j,i)   + sk(k,j,i-1)    )     &
     4009                                      -      (  8.0_wp * ibit2_l * adv_sca_5   &
     4010                                          +              ibit1_l * adv_sca_3   &
     4011                                             ) *                               &
     4012                                          ( sk(k,j,i+1) + sk(k,j,i-2)    )     &
     4013                                      +      (           ibit2_l * adv_sca_5   &
     4014                                             ) *                               &
     4015                                          ( sk(k,j,i+2) + sk(k,j,i-3)    )     &
     4016                                                       )
     4017
     4018                swap_diss_x_local(k,j,tn) = -ABS( u_comp_l ) * (               &
     4019                                            ( 10.0_wp * ibit2_l * adv_sca_5    &
     4020                                         +     3.0_wp * ibit1_l * adv_sca_3    &
     4021                                         +              ibit0_l * adv_sca_1    &
     4022                                            ) *                                &
     4023                                         ( sk(k,j,i)   - sk(k,j,i-1) )         &
     4024                                     -      (  5.0_wp * ibit2_l * adv_sca_5    &
     4025                                         +              ibit1_l * adv_sca_3    &
     4026                                            ) *                                &
     4027                                        ( sk(k,j,i+1) - sk(k,j,i-2)  )         &
     4028                                     +      (           ibit2_l * adv_sca_5    &
     4029                                            ) *                                &
     4030                                         ( sk(k,j,i+2) - sk(k,j,i-3) )         &
     4031                                                               )
    40424032#endif
    4043 
    40444033                ibit5 = REAL( IBITS(advc_flag(k,j,i),5,1), KIND = wp )
    40454034                ibit4 = REAL( IBITS(advc_flag(k,j,i),4,1), KIND = wp )
    40464035                ibit3 = REAL( IBITS(advc_flag(k,j,i),3,1), KIND = wp )
    40474036
    4048                 v_comp = v(k,j+1,i) - v_gtrans + v_stokes_zu(k)
    4049                 flux_n = v_comp * (                                           &
    4050                           ( 37.0_wp * ibit5 * adv_sca_5                       &
    4051                        +     7.0_wp * ibit4 * adv_sca_3                       &
    4052                        +              ibit3 * adv_sca_1                       &
    4053                           ) *                                                 &
    4054                              ( sk(k,j+1,i) + sk(k,j,i)   )                    &
    4055                    -      (  8.0_wp * ibit5 * adv_sca_5                       &
    4056                        +              ibit4 * adv_sca_3                       &
    4057                           ) *                                                 &
    4058                              ( sk(k,j+2,i) + sk(k,j-1,i) )                    &
    4059                    +      (           ibit5 * adv_sca_5                       &
    4060                           ) *                                                 &
    4061                              ( sk(k,j+3,i) + sk(k,j-2,i) )                    &
     4037                v_comp    = v(k,j+1,i) - v_gtrans + v_stokes_zu(k)
     4038                flux_n(k) = v_comp * (                                         &
     4039                           ( 37.0_wp * ibit5 * adv_sca_5                       &
     4040                        +     7.0_wp * ibit4 * adv_sca_3                       &
     4041                        +              ibit3 * adv_sca_1                       &
     4042                           ) *                                                 &
     4043                                   ( sk(k,j+1,i) + sk(k,j,i)   )               &
     4044                    -      (  8.0_wp * ibit5 * adv_sca_5                       &
     4045                        +              ibit4 * adv_sca_3                       &
     4046                           ) *                                                 &
     4047                                   ( sk(k,j+2,i) + sk(k,j-1,i) )               &
     4048                    +      (           ibit5 * adv_sca_5                       &
     4049                           ) *                                                 &
     4050                                   ( sk(k,j+3,i) + sk(k,j-2,i) )               &
    40624051                                     )
    40634052
    4064                 diss_n = -ABS( v_comp ) * (                                   &
    4065                           ( 10.0_wp * ibit5 * adv_sca_5                       &
    4066                        +     3.0_wp * ibit4 * adv_sca_3                       &
    4067                        +              ibit3 * adv_sca_1                       &
    4068                           ) *                                                 &
    4069                              ( sk(k,j+1,i) - sk(k,j,i)    )                   &
    4070                    -      (  5.0_wp * ibit5 * adv_sca_5                       &
    4071                        +              ibit4 * adv_sca_3                       &
    4072                           ) *                                                 &
    4073                              ( sk(k,j+2,i) - sk(k,j-1,i)  )                   &
    4074                    +      (           ibit5 * adv_sca_5                       &
    4075                           ) *                                                 &
    4076                              ( sk(k,j+3,i) - sk(k,j-2,i) )                    &
     4053                diss_n(k) = -ABS( v_comp ) * (                                 &
     4054                           ( 10.0_wp * ibit5 * adv_sca_5                       &
     4055                        +     3.0_wp * ibit4 * adv_sca_3                       &
     4056                        +              ibit3 * adv_sca_1                       &
     4057                           ) *                                                 &
     4058                                   ( sk(k,j+1,i) - sk(k,j,i)   )               &
     4059                    -      (  5.0_wp * ibit5 * adv_sca_5                       &
     4060                        +              ibit4 * adv_sca_3                       &
     4061                           ) *                                                 &
     4062                                   ( sk(k,j+2,i) - sk(k,j-1,i) )               &
     4063                    +      (           ibit5 * adv_sca_5                       &
     4064                           ) *                                                 &
     4065                                   ( sk(k,j+3,i) - sk(k,j-2,i) )               &
    40774066                                             )
    4078 
    40794067#ifdef _OPENACC
    40804068!
     
    40844072                ibit3_s = REAL( IBITS(advc_flag(k,j-1,i),3,1), KIND = wp )
    40854073
    4086                 v_comp_s = v(k,j,i) - v_gtrans + v_stokes_zu(k)
    4087                 flux_s = v_comp_s * (                                         &
    4088                                              ( 37.0_wp * ibit5_s * adv_sca_5  &
    4089                                           +     7.0_wp * ibit4_s * adv_sca_3  &
    4090                                           +              ibit3_s * adv_sca_1  &
    4091                                              ) *                              &
    4092                                          ( sk(k,j,i)  + sk(k,j-1,i)     )     &
    4093                                        -     (  8.0_wp * ibit5_s * adv_sca_5  &
    4094                                           +              ibit4_s * adv_sca_3  &
    4095                                               ) *                             &
    4096                                          ( sk(k,j+1,i) + sk(k,j-2,i)    )     &
    4097                                       +      (           ibit5_s * adv_sca_5  &
    4098                                              ) *                              &
    4099                                         ( sk(k,j+2,i) + sk(k,j-3,i)     )     &
    4100                                              )
    4101 
    4102                 diss_s = -ABS( v_comp_s ) * (                                 &
    4103                                              ( 10.0_wp * ibit5_s * adv_sca_5  &
    4104                                           +     3.0_wp * ibit4_s * adv_sca_3  &
    4105                                           +              ibit3_s * adv_sca_1  &
    4106                                              ) *                              &
    4107                                           ( sk(k,j,i)   - sk(k,j-1,i)    )    &
    4108                                       -      (  5.0_wp * ibit5_s * adv_sca_5  &
    4109                                           +              ibit4_s * adv_sca_3  &
    4110                                              ) *                              &
    4111                                           ( sk(k,j+1,i) - sk(k,j-2,i)    )    &
    4112                                       +      (           ibit5_s * adv_sca_5  &
    4113                                              ) *                              &
    4114                                           ( sk(k,j+2,i) - sk(k,j-3,i)    )    &
     4074                v_comp_s                = v(k,j,i) - v_gtrans + v_stokes_zu(k)
     4075                swap_flux_y_local(k,tn) = v_comp_s * (                         &
     4076                                             ( 37.0_wp * ibit5_s * adv_sca_5   &
     4077                                          +     7.0_wp * ibit4_s * adv_sca_3   &
     4078                                          +              ibit3_s * adv_sca_1   &
     4079                                             ) *                               &
     4080                                         ( sk(k,j,i)  + sk(k,j-1,i)     )      &
     4081                                       -     (  8.0_wp * ibit5_s * adv_sca_5   &
     4082                                          +              ibit4_s * adv_sca_3   &
     4083                                              ) *                              &
     4084                                         ( sk(k,j+1,i) + sk(k,j-2,i)    )      &
     4085                                      +      (           ibit5_s * adv_sca_5   &
     4086                                             ) *                               &
     4087                                        ( sk(k,j+2,i) + sk(k,j-3,i)     )      &
    41154088                                                     )
    4116 #else
    4117                 flux_s = swap_flux_y_local(k)
    4118                 diss_s = swap_diss_y_local(k)
     4089
     4090                swap_flux_y_local(k,tn) = -ABS( v_comp_s ) * (                 &
     4091                                             ( 10.0_wp * ibit5_s * adv_sca_5   &
     4092                                          +     3.0_wp * ibit4_s * adv_sca_3   &
     4093                                          +              ibit3_s * adv_sca_1   &
     4094                                             ) *                               &
     4095                                          ( sk(k,j,i)   - sk(k,j-1,i)    )     &
     4096                                      -      (  5.0_wp * ibit5_s * adv_sca_5   &
     4097                                          +              ibit4_s * adv_sca_3   &
     4098                                             ) *                               &
     4099                                          ( sk(k,j+1,i) - sk(k,j-2,i)    )     &
     4100                                      +      (           ibit5_s * adv_sca_5   &
     4101                                             ) *                               &
     4102                                          ( sk(k,j+2,i) - sk(k,j-3,i)    )     &
     4103                                                             )
    41194104#endif
    4120 
    4121 !
    4122 !--             k index has to be modified near bottom and top, else array
    4123 !--             subscripts will be exceeded.
     4105             ENDDO
     4106!
     4107!--          Now compute the fluxes and tendency terms for the horizontal and
     4108!--          vertical parts above the top of the highest topography. No degradation
     4109!--          for the horizontal parts, but for the vertical it is stell needed.
     4110             DO  k = nzb_max_l+1, nzt
     4111
     4112                u_comp    = u(k,j,i+1) - u_gtrans + u_stokes_zu(k)
     4113                flux_r(k) = u_comp * (                                         &
     4114                            37.0_wp * ( sk(k,j,i+1) + sk(k,j,i)   )            &
     4115                          -  8.0_wp * ( sk(k,j,i+2) + sk(k,j,i-1) )            &
     4116                          +           ( sk(k,j,i+3) + sk(k,j,i-2) ) ) * adv_sca_5
     4117                diss_r(k) = -ABS( u_comp ) * (                                 &
     4118                            10.0_wp * ( sk(k,j,i+1) - sk(k,j,i)   )            &
     4119                          -  5.0_wp * ( sk(k,j,i+2) - sk(k,j,i-1) )            &
     4120                          +           ( sk(k,j,i+3) - sk(k,j,i-2) ) ) * adv_sca_5
     4121#ifdef _OPENACC
     4122!
     4123!--             Recompute the left fluxes.
     4124                u_comp_l                  = u(k,j,i) - u_gtrans + u_stokes_zu(k)
     4125                swap_flux_x_local(k,j,tn) = u_comp_l * (                       &
     4126                                      37.0_wp * ( sk(k,j,i)   + sk(k,j,i-1) )  &
     4127                                    -  8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) )  &
     4128                                    +           ( sk(k,j,i+2) + sk(k,j,i-3) )  &
     4129                                                       ) * adv_sca_5
     4130
     4131                swap_diss_x_local(k,j,tn) = -ABS( u_comp_l ) * (               &
     4132                                      10.0_wp * ( sk(k,j,i)   - sk(k,j,i-1) )  &
     4133                                    -  5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) )  &
     4134                                    +           ( sk(k,j,i+2) - sk(k,j,i-3) )  &
     4135                                                               ) * adv_sca_5
     4136#endif
     4137
     4138                v_comp    = v(k,j+1,i) - v_gtrans + v_stokes_zu(k)
     4139                flux_n(k) = v_comp * (                                         &
     4140                            37.0_wp * ( sk(k,j+1,i) + sk(k,j,i)   )            &
     4141                          -  8.0_wp * ( sk(k,j+2,i) + sk(k,j-1,i) )            &
     4142                          +           ( sk(k,j+3,i) + sk(k,j-2,i) ) ) * adv_sca_5
     4143                diss_n(k) = -ABS( v_comp ) * (                                 &
     4144                            10.0_wp * ( sk(k,j+1,i) - sk(k,j,i)   )            &
     4145                          -  5.0_wp * ( sk(k,j+2,i) - sk(k,j-1,i) )            &
     4146                          +           ( sk(k,j+3,i) - sk(k,j-2,i) ) ) * adv_sca_5
     4147#ifdef _OPENACC
     4148!
     4149!--             Recompute the south fluxes.
     4150                v_comp_s                = v(k,j,i) - v_gtrans + v_stokes_zu(k)
     4151                swap_flux_y_local(k,tn) = v_comp_s * (                         &
     4152                                    37.0_wp * ( sk(k,j,i)   + sk(k,j-1,i) )    &
     4153                                  -  8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) )    &
     4154                                  +           ( sk(k,j+2,i) + sk(k,j-3,i) )    &
     4155                                                     ) * adv_sca_5
     4156                swap_diss_y_local(k,tn) = -ABS( v_comp_s ) * (                 &
     4157                                    10.0_wp * ( sk(k,j,i)   - sk(k,j-1,i) )    &
     4158                                  -  5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) )    &
     4159                                  +             sk(k,j+2,i) - sk(k,j-3,i)      &
     4160                                                             ) * adv_sca_5
     4161#endif
     4162             ENDDO
     4163!
     4164!--          Now, compute vertical fluxes. Split loop into a part treating the
     4165!--          lowest grid points with indirect indexing, a main loop without
     4166!--          indirect indexing, and a loop for the uppermost grip points with
     4167!--          indirect indexing. This allows better vectorization for the main loop.
     4168!--          First, compute the flux at model surface, which need has to be
     4169!--          calculated explicetely for the tendency at
     4170!--          the first w-level. For topography wall this is done implicitely by
     4171!--          advc_flag.
     4172             flux_t(nzb) = 0.0_wp
     4173             diss_t(nzb) = 0.0_wp
     4174
     4175             DO  k = nzb+1, nzb+1
    41244176                ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
    41254177                ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
    41264178                ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
    4127 
     4179!
     4180!--             k index has to be modified near bottom and top, else array
     4181!--             subscripts will be exceeded.
    41284182                k_ppp = k + 3 * ibit8
    41294183                k_pp  = k + 2 * ( 1 - ibit6  )
     
    41314185
    41324186
    4133                 flux_t = w(k,j,i) * rho_air_zw(k) * (                         &
    4134                            ( 37.0_wp * ibit8 * adv_sca_5                      &
    4135                         +     7.0_wp * ibit7 * adv_sca_3                      &
    4136                         +           ibit6 * adv_sca_1                         &
    4137                            ) *                                                &
    4138                                    ( sk(k+1,j,i)  + sk(k,j,i)    )            &
    4139                     -      (  8.0_wp * ibit8 * adv_sca_5                      &
    4140                         +              ibit7 * adv_sca_3                      &
    4141                            ) *                                                &
    4142                                    ( sk(k_pp,j,i) + sk(k-1,j,i)  )            &
    4143                     +      (           ibit8 * adv_sca_5                      &
    4144                            ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )            &
    4145                                        )
    4146 
    4147                 diss_t = -ABS( w(k,j,i) ) * rho_air_zw(k) * (                 &
    4148                            ( 10.0_wp * ibit8 * adv_sca_5                      &
    4149                         +     3.0_wp * ibit7 * adv_sca_3                      &
    4150                         +              ibit6 * adv_sca_1                      &
    4151                            ) *                                                &
    4152                                    ( sk(k+1,j,i)   - sk(k,j,i)    )           &
    4153                     -      (  5.0_wp * ibit8 * adv_sca_5                      &
    4154                         +              ibit7 * adv_sca_3                      &
    4155                            ) *                                                &
    4156                                    ( sk(k_pp,j,i)  - sk(k-1,j,i)  )           &
    4157                     +      (           ibit8 * adv_sca_5                      &
    4158                            ) *                                                &
    4159                                    ( sk(k_ppp,j,i) - sk(k_mm,j,i) )           &
    4160                                                )
    4161 !
    4162 !--             Calculate the divergence of the velocity field. A respective
    4163 !--             correction is needed to overcome numerical instabilities caused
    4164 !--             by a not sufficient reduction of divergences near topography.
    4165                 div   =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )             &
    4166                           - u(k,j,i)   * (                                     &
    4167                         REAL( IBITS(advc_flag(k,j,i-1),0,1), KIND = wp )       &
    4168                       + REAL( IBITS(advc_flag(k,j,i-1),1,1), KIND = wp )       &
    4169                       + REAL( IBITS(advc_flag(k,j,i-1),2,1), KIND = wp )       &
    4170                                          )                                     &
    4171                           ) * ddx                                              &
    4172                         + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )             &
    4173                           - v(k,j,i)   * (                                     &
    4174                         REAL( IBITS(advc_flag(k,j-1,i),3,1), KIND = wp )       &
    4175                       + REAL( IBITS(advc_flag(k,j-1,i),4,1), KIND = wp )       &
    4176                       + REAL( IBITS(advc_flag(k,j-1,i),5,1), KIND = wp )       &
    4177                                          )                                     &
    4178                           ) * ddy                                              &
    4179                         + ( w(k,j,i) * rho_air_zw(k) *                         &
    4180                                          ( ibit6 + ibit7 + ibit8 )             &
    4181                           - w(k-1,j,i) * rho_air_zw(k-1) *                     &
    4182                                          (                                     &
    4183                         REAL( IBITS(advc_flag(k-1,j,i),6,1), KIND = wp )       &
    4184                       + REAL( IBITS(advc_flag(k-1,j,i),7,1), KIND = wp )       &
    4185                       + REAL( IBITS(advc_flag(k-1,j,i),8,1), KIND = wp )       &
    4186                                          )                                     &     
    4187                           ) * drho_air(k) * ddzw(k)
    4188 
    4189 
    4190                 tend(k,j,i) = tend(k,j,i) - (                                 &
    4191                         ( ( flux_r + diss_r )                                 &
    4192                       -   ( flux_l + diss_l ) ) * ddx                         &
    4193                       + ( ( flux_n + diss_n )                                 &
    4194                       -   ( flux_s + diss_s ) ) * ddy                         &
    4195                       + ( ( flux_t + diss_t )                                 &
    4196                       -   ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k)       &
    4197                                             ) + sk(k,j,i) * div
    4198 
    4199 #ifndef _OPENACC
    4200                 swap_flux_y_local(k)   = flux_n
    4201                 swap_diss_y_local(k)   = diss_n
    4202                 swap_flux_x_local(k,j) = flux_r
    4203                 swap_diss_x_local(k,j) = diss_r
    4204 #endif
    4205                 flux_d                 = flux_t
    4206                 diss_d                 = diss_t
    4207 
    4208 !
    4209 !--             Evaluation of statistics.
    4210                 SELECT CASE ( sk_num )
    4211 
    4212                     CASE ( 1 )
    4213                        !$ACC ATOMIC
    4214                        sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn)           &
    4215                           + ( flux_t                                           &
    4216                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4217                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4218                             + diss_t                                           &
    4219                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4220                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4221                             ) * weight_substep(intermediate_timestep_count)
    4222                     CASE ( 2 )
    4223                        !$ACC ATOMIC
    4224                        sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn)           &
    4225                           + ( flux_t                                           &
    4226                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4227                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4228                             + diss_t                                           &
    4229                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4230                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4231                             ) * weight_substep(intermediate_timestep_count)
    4232                     CASE ( 3 )
    4233                        !$ACC ATOMIC
    4234                        sums_wsqs_ws_l(k,tn)  = sums_wsqs_ws_l(k,tn)            &
    4235                           + ( flux_t                                           &
    4236                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4237                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4238                             + diss_t                                           &
    4239                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4240                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4241                             ) * weight_substep(intermediate_timestep_count)
    4242                     CASE ( 4 )
    4243                        !$ACC ATOMIC
    4244                        sums_wsqcs_ws_l(k,tn)  = sums_wsqcs_ws_l(k,tn)          &
    4245                           + ( flux_t                                           &
    4246                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4247                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4248                             + diss_t                                           &
    4249                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4250                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4251                             ) * weight_substep(intermediate_timestep_count)
    4252                     CASE ( 5 )
    4253                        !$ACC ATOMIC
    4254                        sums_wsqrs_ws_l(k,tn)  = sums_wsqrs_ws_l(k,tn)          &
    4255                           + ( flux_t                                           &
    4256                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4257                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4258                             + diss_t                                           &
    4259                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4260                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4261                             ) * weight_substep(intermediate_timestep_count)
    4262                     CASE ( 6 )
    4263                        !$ACC ATOMIC
    4264                        sums_wsncs_ws_l(k,tn)  = sums_wsncs_ws_l(k,tn)          &
    4265                           + ( flux_t                                           &
    4266                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4267                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4268                             + diss_t                                           &
    4269                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4270                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4271                             ) * weight_substep(intermediate_timestep_count)
    4272                     CASE ( 7 )
    4273                        !$ACC ATOMIC
    4274                        sums_wsnrs_ws_l(k,tn)  = sums_wsnrs_ws_l(k,tn)          &
    4275                           + ( flux_t                                           &
    4276                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4277                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4278                             + diss_t                                           &
    4279                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4280                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4281                             ) * weight_substep(intermediate_timestep_count)
    4282                     CASE ( 8 )
    4283                        !$ACC ATOMIC
    4284                        sums_wsss_ws_l(k,tn)  = sums_wsss_ws_l(k,tn)            &
    4285                           + ( flux_t                                           &
    4286                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4287                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4288                             + diss_t                                           &
    4289                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4290                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4291                             ) * weight_substep(intermediate_timestep_count)
    4292                     CASE ( 9 )
    4293                         !$ACC ATOMIC
    4294                         sums_salsa_ws_l(k,tn)  = sums_salsa_ws_l(k,tn)         &
    4295                           + ( flux_t                                           &
    4296                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4297                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4298                             + diss_t                                           &
    4299                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4300                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4301                             ) * weight_substep(intermediate_timestep_count)
    4302 
    4303                 END SELECT
    4304 
     4187                flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                       &
     4188                           ( 37.0_wp * ibit8 * adv_sca_5                       &
     4189                        +     7.0_wp * ibit7 * adv_sca_3                       &
     4190                        +              ibit6 * adv_sca_1                       &
     4191                           ) *                                                 &
     4192                                   ( sk(k+1,j,i)  + sk(k,j,i)    )             &
     4193                    -      (  8.0_wp * ibit8 * adv_sca_5                       &
     4194                        +              ibit7 * adv_sca_3                       &
     4195                           ) *                                                 &
     4196                                   ( sk(k_pp,j,i) + sk(k-1,j,i)  )             &
     4197                    +      (           ibit8 * adv_sca_5                       &
     4198                           ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )             &
     4199                                                       )
     4200
     4201                diss_t(k) = -ABS( w(k,j,i) ) * rho_air_zw(k) * (               &
     4202                           ( 10.0_wp * ibit8 * adv_sca_5                       &
     4203                        +     3.0_wp * ibit7 * adv_sca_3                       &
     4204                        +              ibit6 * adv_sca_1                       &
     4205                           ) *                                                 &
     4206                                   ( sk(k+1,j,i)   - sk(k,j,i)    )            &
     4207                    -      (  5.0_wp * ibit8 * adv_sca_5                       &
     4208                        +              ibit7 * adv_sca_3                       &
     4209                           ) *                                                 &
     4210                                   ( sk(k_pp,j,i)  - sk(k-1,j,i)  )            &
     4211                    +      (           ibit8 * adv_sca_5                       &
     4212                           ) *                                                 &
     4213                                   ( sk(k_ppp,j,i) - sk(k_mm,j,i) )            &
     4214                                                               )
    43054215             ENDDO
    43064216
    4307              DO  k = nzb_max_l+1, nzt
    4308 
    4309                 u_comp = u(k,j,i+1) - u_gtrans + u_stokes_zu(k)
    4310                 flux_r = u_comp * (                                           &
    4311                       37.0_wp * ( sk(k,j,i+1) + sk(k,j,i)   )                 &
    4312                     -  8.0_wp * ( sk(k,j,i+2) + sk(k,j,i-1) )                 &
    4313                     +           ( sk(k,j,i+3) + sk(k,j,i-2) ) ) * adv_sca_5
    4314                 diss_r = -ABS( u_comp ) * (                                   &
    4315                       10.0_wp * ( sk(k,j,i+1) - sk(k,j,i)   )                 &
    4316                     -  5.0_wp * ( sk(k,j,i+2) - sk(k,j,i-1) )                 &
    4317                     +           ( sk(k,j,i+3) - sk(k,j,i-2) ) ) * adv_sca_5
    4318 
    4319 #ifdef _OPENACC
    4320 !
    4321 !--             Recompute the left fluxes.
    4322                 u_comp_l = u(k,j,i) - u_gtrans + u_stokes_zu(k)
    4323                 flux_l = u_comp_l * (                                         &
    4324                                       37.0_wp * ( sk(k,j,i)   + sk(k,j,i-1) ) &
    4325                                     -  8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) ) &
    4326                                     +           ( sk(k,j,i+2) + sk(k,j,i-3) ) &
    4327                                                ) * adv_sca_5
    4328 
    4329                 diss_l = -ABS( u_comp_l ) * (                                 &
    4330                                       10.0_wp * ( sk(k,j,i)   - sk(k,j,i-1) ) &
    4331                                     -  5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) ) &
    4332                                     +           ( sk(k,j,i+2) - sk(k,j,i-3) ) &
    4333                                                        ) * adv_sca_5
    4334 #else
    4335                 flux_l = swap_flux_x_local(k,j)
    4336                 diss_l = swap_diss_x_local(k,j)
    4337 #endif
    4338 
    4339                 v_comp = v(k,j+1,i) - v_gtrans + v_stokes_zu(k)
    4340                 flux_n = v_comp * (                                           &
    4341                       37.0_wp * ( sk(k,j+1,i) + sk(k,j,i)   )                 &
    4342                     -  8.0_wp * ( sk(k,j+2,i) + sk(k,j-1,i) )                 &
    4343                     +           ( sk(k,j+3,i) + sk(k,j-2,i) ) ) * adv_sca_5
    4344                 diss_n = -ABS( v_comp ) * (                                   &
    4345                       10.0_wp * ( sk(k,j+1,i) - sk(k,j,i)   )                 &
    4346                     -  5.0_wp * ( sk(k,j+2,i) - sk(k,j-1,i) )                 &
    4347                     +           ( sk(k,j+3,i) - sk(k,j-2,i) ) ) * adv_sca_5
    4348 
    4349 #ifdef _OPENACC
    4350 !
    4351 !--             Recompute the south fluxes.
    4352                 v_comp_s = v(k,j,i) - v_gtrans + v_stokes_zu(k)
    4353                 flux_s = v_comp_s * (                                        &
    4354                                     37.0_wp * ( sk(k,j,i)   + sk(k,j-1,i) )  &
    4355                                   -  8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) )  &
    4356                                   +           ( sk(k,j+2,i) + sk(k,j-3,i) )  &
    4357                                              ) * adv_sca_5
    4358                 diss_s = -ABS( v_comp_s ) * (                                &
    4359                                     10.0_wp * ( sk(k,j,i)   - sk(k,j-1,i) )  &
    4360                                   -  5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) )  &
    4361                                   +             sk(k,j+2,i) - sk(k,j-3,i)    &
    4362                                                       ) * adv_sca_5
    4363 #else
    4364                 flux_s = swap_flux_y_local(k)
    4365                 diss_s = swap_diss_y_local(k)
    4366 #endif
    4367 
    4368 !
    4369 !--             k index has to be modified near bottom and top, else array
    4370 !--             subscripts will be exceeded.
     4217             DO  k = nzb+2, nzt-2
    43714218                ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
    43724219                ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
    43734220                ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
    43744221
     4222                flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                       &
     4223                           ( 37.0_wp * ibit8 * adv_sca_5                       &
     4224                        +     7.0_wp * ibit7 * adv_sca_3                       &
     4225                        +              ibit6 * adv_sca_1                       &
     4226                           ) *                                                 &
     4227                                   ( sk(k+1,j,i)  + sk(k,j,i)    )             &
     4228                    -      (  8.0_wp * ibit8 * adv_sca_5                       &
     4229                        +              ibit7 * adv_sca_3                       &
     4230                           ) *                                                 &
     4231                                   ( sk(k+2,j,i) + sk(k-1,j,i)  )              &
     4232                    +      (           ibit8 * adv_sca_5                       &
     4233                           ) *     ( sk(k+3,j,i)+ sk(k-2,j,i) )                &
     4234                                                       )
     4235
     4236                diss_t(k) = -ABS( w(k,j,i) ) * rho_air_zw(k) * (               &
     4237                           ( 10.0_wp * ibit8 * adv_sca_5                       &
     4238                        +     3.0_wp * ibit7 * adv_sca_3                       &
     4239                        +              ibit6 * adv_sca_1                       &
     4240                           ) *                                                 &
     4241                                   ( sk(k+1,j,i)   - sk(k,j,i)    )            &
     4242                    -      (  5.0_wp * ibit8 * adv_sca_5                       &
     4243                        +              ibit7 * adv_sca_3                       &
     4244                           ) *                                                 &
     4245                                   ( sk(k+2,j,i)  - sk(k-1,j,i)  )             &
     4246                    +      (           ibit8 * adv_sca_5                       &
     4247                           ) *                                                 &
     4248                                   ( sk(k+3,j,i) - sk(k-2,j,i) )               &
     4249                                                               )
     4250             ENDDO
     4251
     4252             DO  k = nzt-1, nzt-symmetry_flag
     4253                ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
     4254                ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
     4255                ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
     4256!
     4257!--             k index has to be modified near bottom and top, else array
     4258!--             subscripts will be exceeded.
    43754259                k_ppp = k + 3 * ibit8
    43764260                k_pp  = k + 2 * ( 1 - ibit6  )
    43774261                k_mm  = k - 2 * ibit8
    43784262
    4379 
    4380                 flux_t = w(k,j,i) * rho_air_zw(k) * (                         &
    4381                            ( 37.0_wp * ibit8 * adv_sca_5                      &
    4382                         +     7.0_wp * ibit7 * adv_sca_3                      &
    4383                         +              ibit6 * adv_sca_1                      &
    4384                            ) *                                                &
    4385                                    ( sk(k+1,j,i)  + sk(k,j,i)     )           &
    4386                     -      (  8.0_wp * ibit8 * adv_sca_5                      &
    4387                         +              ibit7 * adv_sca_3                      &
    4388                            ) *                                                &
    4389                                    ( sk(k_pp,j,i) + sk(k-1,j,i)   )           &
    4390                     +      (           ibit8 * adv_sca_5                      &
    4391                            ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i)  )           &
    4392                                        )
    4393 
    4394                 diss_t = -ABS( w(k,j,i) ) * rho_air_zw(k) * (                 &
    4395                            ( 10.0_wp * ibit8 * adv_sca_5                      &
    4396                         +     3.0_wp * ibit7 * adv_sca_3                      &
    4397                         +              ibit6 * adv_sca_1                      &
    4398                            ) *                                                &
    4399                                    ( sk(k+1,j,i)   - sk(k,j,i)    )           &
    4400                     -      (  5.0_wp * ibit8 * adv_sca_5                      &
    4401                         +              ibit7 * adv_sca_3                      &
    4402                            ) *                                                &
    4403                                    ( sk(k_pp,j,i)  - sk(k-1,j,i)  )           &
    4404                     +      (           ibit8 * adv_sca_5                      &
    4405                            ) *                                                &
    4406                                    ( sk(k_ppp,j,i) - sk(k_mm,j,i) )           &
    4407                                                )
     4263                flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                       &
     4264                           ( 37.0_wp * ibit8 * adv_sca_5                       &
     4265                        +     7.0_wp * ibit7 * adv_sca_3                       &
     4266                        +              ibit6 * adv_sca_1                       &
     4267                           ) *                                                 &
     4268                                   ( sk(k+1,j,i)  + sk(k,j,i)    )             &
     4269                    -      (  8.0_wp * ibit8 * adv_sca_5                       &
     4270                        +              ibit7 * adv_sca_3                       &
     4271                           ) *                                                 &
     4272                                   ( sk(k_pp,j,i) + sk(k-1,j,i)  )             &
     4273                    +      (           ibit8 * adv_sca_5                       &
     4274                           ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )             &
     4275                                                       )
     4276
     4277                diss_t(k) = -ABS( w(k,j,i) ) * rho_air_zw(k) * (               &
     4278                           ( 10.0_wp * ibit8 * adv_sca_5                       &
     4279                        +     3.0_wp * ibit7 * adv_sca_3                       &
     4280                        +              ibit6 * adv_sca_1                       &
     4281                           ) *                                                 &
     4282                                   ( sk(k+1,j,i)   - sk(k,j,i)    )            &
     4283                    -      (  5.0_wp * ibit8 * adv_sca_5                       &
     4284                        +              ibit7 * adv_sca_3                       &
     4285                           ) *                                                 &
     4286                                   ( sk(k_pp,j,i)  - sk(k-1,j,i)  )            &
     4287                    +      (           ibit8 * adv_sca_5                       &
     4288                           ) *                                                 &
     4289                                   ( sk(k_ppp,j,i) - sk(k_mm,j,i) )            &
     4290                                                               )
     4291             ENDDO
     4292
     4293!
     4294!--          Set resolved/turbulent flux at model top to zero (w-level). In case that
     4295!--          a symmetric behavior between bottom and top shall be guaranteed (closed
     4296!--          channel flow), the flux at nzt is also set to zero.
     4297             IF ( symmetry_flag == 1 ) THEN
     4298                flux_t(nzt) = 0.0_wp
     4299                diss_t(nzt) = 0.0_wp
     4300             ENDIF
     4301             flux_t(nzt+1) = 0.0_wp
     4302             diss_t(nzt+1) = 0.0_wp
     4303
     4304             DO  k = nzb+1, nzb_max_l
     4305
     4306                flux_d    = flux_t(k-1)
     4307                diss_d    = diss_t(k-1)
     4308
     4309                ibit2 = REAL( IBITS(advc_flag(k,j,i),2,1), KIND = wp )
     4310                ibit1 = REAL( IBITS(advc_flag(k,j,i),1,1), KIND = wp )
     4311                ibit0 = REAL( IBITS(advc_flag(k,j,i),0,1), KIND = wp )
     4312
     4313                ibit5 = REAL( IBITS(advc_flag(k,j,i),5,1), KIND = wp )
     4314                ibit4 = REAL( IBITS(advc_flag(k,j,i),4,1), KIND = wp )
     4315                ibit3 = REAL( IBITS(advc_flag(k,j,i),3,1), KIND = wp )
     4316
     4317                ibit8 = REAL( IBITS(advc_flag(k,j,i),8,1), KIND = wp )
     4318                ibit7 = REAL( IBITS(advc_flag(k,j,i),7,1), KIND = wp )
     4319                ibit6 = REAL( IBITS(advc_flag(k,j,i),6,1), KIND = wp )
    44084320!
    44094321!--             Calculate the divergence of the velocity field. A respective
    44104322!--             correction is needed to overcome numerical instabilities introduced
    44114323!--             by a not sufficient reduction of divergences near topography.
    4412                 div         =   ( u(k,j,i+1) - u(k,j,i)   ) * ddx              &
    4413                               + ( v(k,j+1,i) - v(k,j,i)   ) * ddy              &
    4414                               + ( w(k,j,i)   * rho_air_zw(k) -                 &
    4415                                   w(k-1,j,i) * rho_air_zw(k-1)                 &
     4324                div         =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )       &
     4325                                - u(k,j,i)   * (                               &
     4326                              REAL( IBITS(advc_flag(k,j,i-1),0,1), KIND = wp ) &
     4327                            + REAL( IBITS(advc_flag(k,j,i-1),1,1), KIND = wp ) &
     4328                            + REAL( IBITS(advc_flag(k,j,i-1),2,1), KIND = wp ) &
     4329                                               )                               &
     4330                                ) * ddx                                        &
     4331                              + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )       &
     4332                                - v(k,j,i)   * (                               &
     4333                              REAL( IBITS(advc_flag(k,j-1,i),3,1), KIND = wp ) &
     4334                            + REAL( IBITS(advc_flag(k,j-1,i),4,1), KIND = wp ) &
     4335                            + REAL( IBITS(advc_flag(k,j-1,i),5,1), KIND = wp ) &
     4336                                               )                               &
     4337                                ) * ddy                                        &
     4338                              + ( w(k,j,i) * rho_air_zw(k) *                   &
     4339                                               ( ibit6 + ibit7 + ibit8 )       &
     4340                                - w(k-1,j,i) * rho_air_zw(k-1) *               &
     4341                                               (                               &
     4342                              REAL( IBITS(advc_flag(k-1,j,i),6,1), KIND = wp ) &
     4343                            + REAL( IBITS(advc_flag(k-1,j,i),7,1), KIND = wp ) &
     4344                            + REAL( IBITS(advc_flag(k-1,j,i),8,1), KIND = wp ) &
     4345                                               )                               &
    44164346                                ) * drho_air(k) * ddzw(k)
    44174347
    4418                 tend(k,j,i) = tend(k,j,i) - (                                 &
    4419                         ( ( flux_r + diss_r )                                 &
    4420                       -   ( flux_l + diss_l ) ) * ddx                         &
    4421                       + ( ( flux_n + diss_n )                                 &
    4422                       -   ( flux_s + diss_s ) ) * ddy                         &
    4423                       + ( ( flux_t + diss_t )                                 &
    4424                       -   ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k)       &
     4348                tend(k,j,i) = tend(k,j,i) - (                                  &
     4349                         ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j,tn) - &
     4350                           swap_diss_x_local(k,j,tn)            ) * ddx        &
     4351                       + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k,tn)   - &
     4352                           swap_diss_y_local(k,tn)              ) * ddy        &
     4353                       + ( ( flux_t(k) + diss_t(k) ) -                         &
     4354                           ( flux_d    + diss_d    )                           &
     4355                                                                )              &
     4356                          * drho_air(k) * ddzw(k) &
    44254357                                            ) + sk(k,j,i) * div
    44264358
    44274359#ifndef _OPENACC
    4428                 swap_flux_y_local(k)   = flux_n
    4429                 swap_diss_y_local(k)   = diss_n
    4430                 swap_flux_x_local(k,j) = flux_r
    4431                 swap_diss_x_local(k,j) = diss_r
     4360                swap_flux_y_local(k,tn)   = flux_n(k)
     4361                swap_diss_y_local(k,tn)   = diss_n(k)
     4362                swap_flux_x_local(k,j,tn) = flux_r(k)
     4363                swap_diss_x_local(k,j,tn) = diss_r(k)
    44324364#endif
    4433                 flux_d                 = flux_t
    4434                 diss_d                 = diss_t
    4435 
    4436 !
    4437 !--             Evaluation of statistics.
    4438                 SELECT CASE ( sk_num )
    4439 
    4440                     CASE ( 1 )
     4365
     4366             ENDDO
     4367
     4368             DO  k = nzb_max_l+1, nzt
     4369
     4370                flux_d    = flux_t(k-1)
     4371                diss_d    = diss_t(k-1)
     4372!
     4373!--             Calculate the divergence of the velocity field. A respective
     4374!--             correction is needed to overcome numerical instabilities introduced
     4375!--             by a not sufficient reduction of divergences near topography.
     4376                div         =   ( u(k,j,i+1) - u(k,j,i) ) * ddx                &
     4377                              + ( v(k,j+1,i) - v(k,j,i) ) * ddy                &
     4378                              + ( w(k,j,i) * rho_air_zw(k)                     &
     4379                                - w(k-1,j,i) * rho_air_zw(k-1)                 &
     4380                                                        ) * drho_air(k) * ddzw(k)
     4381
     4382                tend(k,j,i) = tend(k,j,i) - (                                  &
     4383                         ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j,tn) - &
     4384                           swap_diss_x_local(k,j,tn)            ) * ddx        &
     4385                       + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k,tn)   - &
     4386                           swap_diss_y_local(k,tn)              ) * ddy        &
     4387                       + ( ( flux_t(k) + diss_t(k) ) -                         &
     4388                           ( flux_d    + diss_d    )            )              &
     4389                           * drho_air(k) * ddzw(k)                             &
     4390                                            ) + sk(k,j,i) * div
     4391
     4392#ifndef _OPENACC
     4393                swap_flux_y_local(k,tn)   = flux_n(k)
     4394                swap_diss_y_local(k,tn)   = diss_n(k)
     4395                swap_flux_x_local(k,j,tn) = flux_r(k)
     4396                swap_diss_x_local(k,j,tn) = diss_r(k)
     4397#endif
     4398            ENDDO
     4399
     4400!
     4401!--         Evaluation of statistics.
     4402            DO  k = nzb+1, nzt
     4403               SELECT CASE ( sk_num )
     4404
     4405                   CASE ( 1 )
     4406                      !$ACC ATOMIC
     4407                      sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn)            &
     4408                         + ( flux_t(k)                                         &
     4409                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )   &
     4410                               * ( w(k,j,i) - hom(k,1,3,0)                 )   &
     4411                           + diss_t(k)                                         &
     4412                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )   &
     4413                               *   ABS(w(k,j,i) - hom(k,1,3,0)             )   &
     4414                           ) * weight_substep(intermediate_timestep_count)
     4415                   CASE ( 2 )
     4416                      !$ACC ATOMIC
     4417                      sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn)            &
     4418                         + ( flux_t(k)                                         &
     4419                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )   &
     4420                               * ( w(k,j,i) - hom(k,1,3,0)                 )   &
     4421                           + diss_t(k)                                         &
     4422                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )   &
     4423                               *   ABS(w(k,j,i) - hom(k,1,3,0)             )   &
     4424                           ) * weight_substep(intermediate_timestep_count)
     4425                   CASE ( 3 )
     4426                      !$ACC ATOMIC
     4427                      sums_wsqs_ws_l(k,tn)  = sums_wsqs_ws_l(k,tn)             &
     4428                         + ( flux_t(k)                                         &
     4429                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )   &
     4430                               * ( w(k,j,i) - hom(k,1,3,0)                 )   &
     4431                           + diss_t(k)                                         &
     4432                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )   &
     4433                               *   ABS(w(k,j,i) - hom(k,1,3,0)             )   &
     4434                           ) * weight_substep(intermediate_timestep_count)
     4435                   CASE ( 4 )
     4436                      !$ACC ATOMIC
     4437                      sums_wsqcs_ws_l(k,tn)  = sums_wsqcs_ws_l(k,tn)           &
     4438                         + ( flux_t(k)                                         &
     4439                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )   &
     4440                               * ( w(k,j,i) - hom(k,1,3,0)                 )   &
     4441                           + diss_t(k)                                         &
     4442                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )   &
     4443                               *   ABS(w(k,j,i) - hom(k,1,3,0)             )   &
     4444                           ) * weight_substep(intermediate_timestep_count)
     4445                   CASE ( 5 )
     4446                      !$ACC ATOMIC
     4447                      sums_wsqrs_ws_l(k,tn)  = sums_wsqrs_ws_l(k,tn)           &
     4448                         + ( flux_t(k)                                         &
     4449                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )   &
     4450                               * ( w(k,j,i) - hom(k,1,3,0)                 )   &
     4451                           + diss_t(k)                                         &
     4452                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )   &
     4453                               *   ABS(w(k,j,i) - hom(k,1,3,0)             )   &
     4454                           ) * weight_substep(intermediate_timestep_count)
     4455                   CASE ( 6 )
     4456                      !$ACC ATOMIC
     4457                      sums_wsncs_ws_l(k,tn)  = sums_wsncs_ws_l(k,tn)           &
     4458                         + ( flux_t(k)                                         &
     4459                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )   &
     4460                               * ( w(k,j,i) - hom(k,1,3,0)                 )   &
     4461                           + diss_t(k)                                         &
     4462                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )   &
     4463                               *   ABS(w(k,j,i) - hom(k,1,3,0)             )   &
     4464                           ) * weight_substep(intermediate_timestep_count)
     4465                   CASE ( 7 )
     4466                      !$ACC ATOMIC
     4467                      sums_wsnrs_ws_l(k,tn)  = sums_wsnrs_ws_l(k,tn)           &
     4468                         + ( flux_t(k)                                         &
     4469                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )   &
     4470                               * ( w(k,j,i) - hom(k,1,3,0)                 )   &
     4471                           + diss_t(k)                                         &
     4472                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )   &
     4473                               *   ABS(w(k,j,i) - hom(k,1,3,0)             )   &
     4474                           ) * weight_substep(intermediate_timestep_count)
     4475                   CASE ( 8 )
     4476                      !$ACC ATOMIC
     4477                      sums_wsss_ws_l(k,tn)  = sums_wsss_ws_l(k,tn)             &
     4478                         + ( flux_t(k)                                         &
     4479                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )   &
     4480                               * ( w(k,j,i) - hom(k,1,3,0)                 )   &
     4481                           + diss_t(k)                                         &
     4482                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )   &
     4483                               *   ABS(w(k,j,i) - hom(k,1,3,0)             )   &
     4484                           ) * weight_substep(intermediate_timestep_count)
     4485                   CASE ( 9 )
    44414486                       !$ACC ATOMIC
    4442                        sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn)           &
    4443                           + ( flux_t                                           &
    4444                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4445                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4446                             + diss_t                                           &
    4447                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4448                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4449                             ) * weight_substep(intermediate_timestep_count)
    4450                     CASE ( 2 )
    4451                        !$ACC ATOMIC
    4452                        sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn)           &
    4453                           + ( flux_t                                           &
    4454                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4455                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4456                             + diss_t                                           &
    4457                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4458                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4459                             ) * weight_substep(intermediate_timestep_count)
    4460                     CASE ( 3 )
    4461                        !$ACC ATOMIC
    4462                        sums_wsqs_ws_l(k,tn)  = sums_wsqs_ws_l(k,tn)            &
    4463                           + ( flux_t                                           &
    4464                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4465                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4466                             + diss_t                                           &
    4467                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4468                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4469                             ) * weight_substep(intermediate_timestep_count)
    4470                     CASE ( 4 )
    4471                        !$ACC ATOMIC
    4472                        sums_wsqcs_ws_l(k,tn)  = sums_wsqcs_ws_l(k,tn)          &
    4473                           + ( flux_t                                           &
    4474                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4475                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4476                             + diss_t                                           &
    4477                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4478                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4479                             ) * weight_substep(intermediate_timestep_count)
    4480                     CASE ( 5 )
    4481                        !$ACC ATOMIC
    4482                        sums_wsqrs_ws_l(k,tn)  = sums_wsqrs_ws_l(k,tn)          &
    4483                           + ( flux_t                                           &
    4484                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4485                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4486                             + diss_t                                           &
    4487                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4488                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4489                             ) * weight_substep(intermediate_timestep_count)
    4490                     CASE ( 6 )
    4491                        !$ACC ATOMIC
    4492                        sums_wsncs_ws_l(k,tn)  = sums_wsncs_ws_l(k,tn)          &
    4493                           + ( flux_t                                           &
    4494                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4495                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4496                             + diss_t                                           &
    4497                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4498                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4499                             ) * weight_substep(intermediate_timestep_count)
    4500                     CASE ( 7 )
    4501                        !$ACC ATOMIC
    4502                        sums_wsnrs_ws_l(k,tn)  = sums_wsnrs_ws_l(k,tn)          &
    4503                           + ( flux_t                                           &
    4504                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4505                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4506                             + diss_t                                           &
    4507                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4508                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4509                             ) * weight_substep(intermediate_timestep_count)
    4510                     CASE ( 8 )
    4511                        !$ACC ATOMIC
    4512                        sums_wsss_ws_l(k,tn)  = sums_wsss_ws_l(k,tn)            &
    4513                           + ( flux_t                                           &
    4514                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4515                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4516                             + diss_t                                           &
    4517                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4518                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4519                             ) * weight_substep(intermediate_timestep_count)
    4520                     CASE ( 9 )
    4521                         !$ACC ATOMIC
    4522                         sums_salsa_ws_l(k,tn)  = sums_salsa_ws_l(k,tn)         &
    4523                           + ( flux_t                                           &
    4524                                 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    4525                                 * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    4526                             + diss_t                                           &
    4527                                 / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    4528                                 *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    4529                             ) * weight_substep(intermediate_timestep_count)
     4487                       sums_salsa_ws_l(k,tn)  = sums_salsa_ws_l(k,tn)          &
     4488                         + ( flux_t(k)                                         &
     4489                               / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )   &
     4490                               * ( w(k,j,i) - hom(k,1,3,0)                 )   &
     4491                           + diss_t(k)                                         &
     4492                               / ( ABS(w(k,j,i)) + 1.0E-20_wp              )   &
     4493                               *   ABS(w(k,j,i) - hom(k,1,3,0)             )   &
     4494                           ) * weight_substep(intermediate_timestep_count)
    45304495
    45314496                END SELECT
    45324497
    45334498             ENDDO
    4534 
    4535          ENDDO
    4536       ENDDO
     4499          ENDDO
     4500       ENDDO
     4501
     4502       CALL cpu_log( log_point_s(49), 'advec_s_ws', 'stop' )
    45374503
    45384504    END SUBROUTINE advec_s_ws
     
    45534519       INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
    45544520       INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
    4555        INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms 
    4556        INTEGER(iwp) ::  tn = 0    !< number of OpenMP thread
    4557        
     4521       INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
     4522       INTEGER(iwp) ::  tn = 0    !< number of OpenMP thread (is always zero here)
     4523
    45584524       REAL(wp)    ::  ibit0 !< flag indicating 1st-order scheme along x-direction
    45594525       REAL(wp)    ::  ibit1 !< flag indicating 3rd-order scheme along x-direction
     
    45794545       REAL(wp)    ::  flux_d !< 6th-order flux at grid box bottom
    45804546       REAL(wp)    ::  gu     !< Galilei-transformation velocity along x
    4581        REAL(wp)    ::  gv     !< Galilei-transformation velocity along y
    4582        REAL(wp)    ::  v_comp !< advection velocity along y
    4583 #ifdef _OPENACC
     4547       REAL(wp)    ::  gv     !< Galilei-transformation velocity along y
     4548       REAL(wp)    ::  u_comp_l !<
    45844549       REAL(wp)    ::  v_comp_s !< advection velocity along y
    4585 #endif
    4586        REAL(wp)    ::  w_comp !< advection velocity along z
    4587        
    4588        REAL(wp)    :: diss_s  !< discretized artificial dissipation at southward-side of the grid box
    4589        REAL(wp)    :: flux_s  !< discretized 6th-order flux at southward-side of the grid box
    4590 #ifndef _OPENACC
    4591        REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local_u !< discretized artificial dissipation at southward-side of the grid box
    4592        REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local_u !< discretized 6th-order flux at southward-side of the grid box
    4593 #endif
    4594        
    4595        REAL(wp)    :: diss_l  !< discretized artificial dissipation at leftward-side of the grid box
    4596        REAL(wp)    :: flux_l  !< discretized 6th-order flux at leftward-side of the grid box
    4597 #ifndef _OPENACC
    4598        REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_u !< discretized artificial dissipation at leftward-side of the grid box
    4599        REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local_u !< discretized 6th-order flux at leftward-side of the grid box
    4600 #endif
    4601        
    4602        REAL(wp) ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
    4603        REAL(wp) ::  diss_r !< discretized artificial dissipation at leftward-side of the grid box
    4604        REAL(wp) ::  diss_t !< discretized artificial dissipation at top of the grid box
    4605        REAL(wp) ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
    4606        REAL(wp) ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
    4607        REAL(wp) ::  flux_t !< discretized 6th-order flux at top of the grid box
    4608        REAL(wp) ::  u_comp !< advection velocity along x
    4609 #ifdef _OPENACC
    4610        REAL(wp)    ::  u_comp_l !<
    4611 #endif
    4612 !
    4613 !--    Set local version of nzb_max. At non-cyclic boundaries the order of the
    4614 !--    advection need to be degraded near the boundary. Please note, in contrast
    4615 !--    to the cache-optimized routines, nzb_max_l is set constantly for the
    4616 !--    entire subdomain, in order to avoid unsymmetric loops which might be
    4617 !--    an issue for GPUs.
    4618        IF( bc_dirichlet_l  .OR.  bc_radiation_l  .OR.                          &
    4619            bc_dirichlet_r  .OR.  bc_radiation_r  .OR.                          &
    4620            bc_dirichlet_s  .OR.  bc_radiation_s  .OR.                          &
    4621            bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
    4622           nzb_max_l = nzt
    4623        ELSE
    4624           nzb_max_l = nzb_max
    4625        END IF
    4626  
     4550
     4551       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
     4552       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
     4553       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_t !< discretized artificial dissipation at top of the grid box
     4554       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
     4555       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
     4556       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_t !< discretized 6th-order flux at top of the grid box
     4557       REAL(wp), DIMENSION(nzb:nzt+1) ::  u_comp !< advection velocity along x
     4558       REAL(wp), DIMENSION(nzb:nzt+1) ::  v_comp !< advection velocity along y
     4559       REAL(wp), DIMENSION(nzb:nzt+1) ::  w_comp !< advection velocity along z
     4560
     4561       CALL cpu_log( log_point_s(68), 'advec_u_ws', 'start' )
     4562
    46274563       gu = 2.0_wp * u_gtrans
    46284564       gv = 2.0_wp * v_gtrans
    4629 
    4630 #ifndef _OPENACC
    4631 !
    4632 !--    Compute the fluxes for the whole left boundary of the processor domain.
    4633        i = nxlu
    4634        DO  j = nys, nyn
    4635           DO  k = nzb+1, nzb_max_l
    4636 
    4637              ibit2 = REAL( IBITS(advc_flags_m(k,j,i-1),2,1), KIND = wp )
    4638              ibit1 = REAL( IBITS(advc_flags_m(k,j,i-1),1,1), KIND = wp )
    4639              ibit0 = REAL( IBITS(advc_flags_m(k,j,i-1),0,1), KIND = wp )
    4640 
    4641              u_comp                   = u(k,j,i) + u(k,j,i-1) - gu
    4642              swap_flux_x_local_u(k,j) = u_comp * (                             &
    4643                                        ( 37.0_wp * ibit2 * adv_mom_5           &
    4644                                     +     7.0_wp * ibit1 * adv_mom_3           &
    4645                                     +              ibit0 * adv_mom_1           &
    4646                                        ) *                                     &
    4647                                      ( u(k,j,i)   + u(k,j,i-1) )               &
    4648                                 -      (  8.0_wp * ibit2 * adv_mom_5           &
    4649                                     +              ibit1 * adv_mom_3           &
    4650                                        ) *                                     &
    4651                                      ( u(k,j,i+1) + u(k,j,i-2) )               &
    4652                                 +      (           ibit2 * adv_mom_5           &
    4653                                        ) *                                     &
    4654                                      ( u(k,j,i+2) + u(k,j,i-3) )               &
    4655                                                    )
    4656 
    4657               swap_diss_x_local_u(k,j) = - ABS( u_comp ) * (                   &
    4658                                        ( 10.0_wp * ibit2 * adv_mom_5           &
    4659                                     +     3.0_wp * ibit1 * adv_mom_3           &
    4660                                     +              ibit0 * adv_mom_1          &
    4661                                        ) *                                     &
    4662                                      ( u(k,j,i)   - u(k,j,i-1) )               &
    4663                                 -      (  5.0_wp * ibit2 * adv_mom_5           &
    4664                                     +              ibit1 * adv_mom_3           &
    4665                                        ) *                                     &
    4666                                      ( u(k,j,i+1) - u(k,j,i-2) )               &
    4667                                 +      (           ibit2 * adv_mom_5           &
    4668                                        ) *                                     &
    4669                                      ( u(k,j,i+2) - u(k,j,i-3) )               &
    4670                                                              )
    4671 
    4672           ENDDO
    4673 
    4674           DO  k = nzb_max_l+1, nzt
    4675 
    4676              u_comp            = u(k,j,i) + u(k,j,i-1) - gu
    4677              swap_flux_x_local_u(k,j) = u_comp * (                             &
    4678                              37.0_wp * ( u(k,j,i) + u(k,j,i-1)   )             &
    4679                            -  8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) )             &
    4680                            +           ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_5
    4681              swap_diss_x_local_u(k,j) = - ABS(u_comp) * (                      &
    4682                              10.0_wp * ( u(k,j,i) - u(k,j,i-1)   )             &
    4683                            -  5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) )             &
    4684                            +           ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_5
    4685 
    4686           ENDDO
    4687        ENDDO
    4688 #endif
    46894565
    46904566       !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, gu, gv) &
     
    46944570       !$ACC PRIVATE(ibit3_s, ibit4_s, ibit5_s) &
    46954571       !$ACC PRIVATE(ibit6, ibit7, ibit8) &
    4696        !$ACC PRIVATE(flux_r, diss_r, flux_l, diss_l) &
    4697        !$ACC PRIVATE(flux_n, diss_n, flux_s, diss_s) &
     4572       !$ACC PRIVATE(flux_r, diss_r) &
     4573       !$ACC PRIVATE(flux_n, diss_n) &
    46984574       !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) &
     4575       !$ACC PRIVATE(flux_l_u, diss_l_u, flux_s_u, diss_s_u) &
    46994576       !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s, w_comp) &
    47004577       !$ACC PRESENT(advc_flags_m) &
     
    47024579       !$ACC PRESENT(drho_air, rho_air_zw, ddzw) &
    47034580       !$ACC PRESENT(tend) &
    4704        !$ACC PRESENT(hom(nzb+1:nzb_max_l,1,1:3,0)) &
     4581       !$ACC PRESENT(hom(:,1,1:3,0)) &
    47054582       !$ACC PRESENT(weight_substep(intermediate_timestep_count)) &
    47064583       !$ACC PRESENT(sums_us2_ws_l, sums_wsus_ws_l)
    4707        DO i = nxlu, nxr
     4584       DO  i = nxlu, nxr
     4585
     4586          DO  j = nys, nyn
     4587!
     4588!--          Used local modified copy of nzb_max (used to degrade order of
     4589!--          discretization) at non-cyclic boundaries. Modify only at relevant points
     4590!--          instead of the entire subdomain. This should lead to better
     4591!--          load balance between boundary and non-boundary PEs.
     4592             IF( ( bc_dirichlet_l  .OR.  bc_radiation_l )  .AND.  i <= nxl + 2  .OR. &
     4593                 ( bc_dirichlet_r  .OR.  bc_radiation_r )  .AND.  i >= nxr - 2  .OR. &
     4594                 ( bc_dirichlet_s  .OR.  bc_radiation_s )  .AND.  j <= nys + 2  .OR. &
     4595                 ( bc_dirichlet_n  .OR.  bc_radiation_n )  .AND.  j >= nyn - 2 )  THEN
     4596                nzb_max_l = nzt
     4597             ELSE
     4598                nzb_max_l = nzb_max
     4599             END IF
    47084600#ifndef _OPENACC
    4709 !       
    4710 !--       The following loop computes the fluxes for the south boundary points
    4711           j = nys
    4712           DO  k = nzb+1, nzb_max_l
    4713 
    4714              ibit5 = REAL( IBITS(advc_flags_m(k,j-1,i),5,1), KIND = wp )
    4715              ibit4 = REAL( IBITS(advc_flags_m(k,j-1,i),4,1), KIND = wp )
    4716              ibit3 = REAL( IBITS(advc_flags_m(k,j-1,i),3,1), KIND = wp )
    4717 
    4718              v_comp                 = v(k,j,i) + v(k,j,i-1) - gv
    4719              swap_flux_y_local_u(k) = v_comp * (                               &
    4720                                    ( 37.0_wp * ibit5 * adv_mom_5               &
    4721                                 +     7.0_wp * ibit4 * adv_mom_3               &
    4722                                 +              ibit3 * adv_mom_1               &
    4723                                    ) *                                         &
    4724                                      ( u(k,j,i)   + u(k,j-1,i) )               &
    4725                             -      (  8.0_wp * ibit5 * adv_mom_5               &
    4726                             +                  ibit4 * adv_mom_3               &
    4727                                    ) *                                         &
    4728                                      ( u(k,j+1,i) + u(k,j-2,i) )               &
    4729                         +      (               ibit5 * adv_mom_5               &
    4730                                ) *                                             &
    4731                                      ( u(k,j+2,i) + u(k,j-3,i) )               &
    4732                                                )                             
    4733                                                                              
    4734              swap_diss_y_local_u(k) = - ABS ( v_comp ) * (                     &
    4735                                    ( 10.0_wp * ibit5 * adv_mom_5               &
    4736                                 +     3.0_wp * ibit4 * adv_mom_3               &
    4737                                 +              ibit3 * adv_mom_1               &
    4738                                    ) *                                         &
    4739                                      ( u(k,j,i)   - u(k,j-1,i) )               &
    4740                             -      (  5.0_wp * ibit5 * adv_mom_5               &
    4741                                 +              ibit4 * adv_mom_3               &
    4742                                    ) *                                         &
    4743                                      ( u(k,j+1,i) - u(k,j-2,i) )               &
    4744                             +      (           ibit5 * adv_mom_5               &
    4745                                    ) *                                         &
    4746                                      ( u(k,j+2,i) - u(k,j-3,i) )               &
    4747                                                          )
    4748 
    4749           ENDDO
    4750 
    4751           DO  k = nzb_max_l+1, nzt
    4752 
    4753              v_comp                 = v(k,j,i) + v(k,j,i-1) - gv
    4754              swap_flux_y_local_u(k) = v_comp * (                               &
    4755                            37.0_wp * ( u(k,j,i)   + u(k,j-1,i) )               &
    4756                          -  8.0_wp * ( u(k,j+1,i) + u(k,j-2,i) )               &
    4757                          +           ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5
    4758              swap_diss_y_local_u(k) = - ABS(v_comp) * (                        &
    4759                            10.0_wp * ( u(k,j,i)   - u(k,j-1,i) )               &
    4760                          -  5.0_wp * ( u(k,j+1,i) - u(k,j-2,i) )               &
    4761                          +           ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_5
    4762 
    4763           ENDDO
     4601!
     4602!--          Compute southside fluxes for the respective boundary of PE
     4603             IF ( j == nys  )  THEN
     4604
     4605                DO  k = nzb+1, nzb_max_l
     4606
     4607                   ibit5 = REAL( IBITS(advc_flags_m(k,j-1,i),5,1), KIND = wp )
     4608                   ibit4 = REAL( IBITS(advc_flags_m(k,j-1,i),4,1), KIND = wp )
     4609                   ibit3 = REAL( IBITS(advc_flags_m(k,j-1,i),3,1), KIND = wp )
     4610
     4611                   v_comp_s       = v(k,j,i) + v(k,j,i-1) - gv
     4612                   flux_s_u(k,tn) = v_comp_s * (                               &
     4613                                  ( 37.0_wp * ibit5 * adv_mom_5                &
     4614                               +     7.0_wp * ibit4 * adv_mom_3                &
     4615                               +              ibit3 * adv_mom_1                &
     4616                                  ) *                                          &
     4617                                              ( u(k,j,i)   + u(k,j-1,i) )      &
     4618                           -      (  8.0_wp * ibit5 * adv_mom_5                &
     4619                               +              ibit4 * adv_mom_3                &
     4620                                  ) *                                          &
     4621                                              ( u(k,j+1,i) + u(k,j-2,i) )      &
     4622                           +      (           ibit5 * adv_mom_5                &
     4623                                  ) *                                          &
     4624                                              ( u(k,j+2,i) + u(k,j-3,i) )      &
     4625                                                )
     4626
     4627                   diss_s_u(k,tn) = - ABS ( v_comp_s ) * (                     &
     4628                                  ( 10.0_wp * ibit5 * adv_mom_5                &
     4629                               +     3.0_wp * ibit4 * adv_mom_3                &
     4630                               +              ibit3 * adv_mom_1                &
     4631                                  ) *                                          &
     4632                                              ( u(k,j,i)   - u(k,j-1,i) )      &
     4633                           -      (  5.0_wp * ibit5 * adv_mom_5                &
     4634                               +              ibit4 * adv_mom_3                &
     4635                                  ) *                                          &
     4636                                              ( u(k,j+1,i) - u(k,j-2,i) )      &
     4637                           +      (           ibit5 * adv_mom_5                &
     4638                                  ) *                                          &
     4639                                              ( u(k,j+2,i) - u(k,j-3,i) )      &
     4640                                                          )
     4641
     4642                ENDDO
     4643
     4644                DO  k = nzb_max_l+1, nzt
     4645
     4646                   v_comp_s       = v(k,j,i) + v(k,j,i-1) - gv
     4647                   flux_s_u(k,tn) = v_comp_s * (                               &
     4648                                 37.0_wp * ( u(k,j,i)   + u(k,j-1,i)   )       &
     4649                               -  8.0_wp * ( u(k,j+1,i) + u(k,j-2,i) )         &
     4650                               +           ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5
     4651                   diss_s_u(k,tn) = - ABS( v_comp_s ) * (                      &
     4652                                 10.0_wp * ( u(k,j,i)   - u(k,j-1,i)   )       &
     4653                               -  5.0_wp * ( u(k,j+1,i) - u(k,j-2,i) )         &
     4654                               +           ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_5
     4655
     4656                ENDDO
     4657
     4658             ENDIF
     4659!
     4660!--          Compute leftside fluxes for the respective boundary of PE
     4661             IF ( i == nxlu )  THEN
     4662
     4663                DO  k = nzb+1, nzb_max_l
     4664
     4665                   ibit2 = REAL( IBITS(advc_flags_m(k,j,i-1),2,1), KIND = wp )
     4666                   ibit1 = REAL( IBITS(advc_flags_m(k,j,i-1),1,1), KIND = wp )
     4667                   ibit0 = REAL( IBITS(advc_flags_m(k,j,i-1),0,1), KIND = wp )
     4668
     4669                   u_comp_l         = u(k,j,i) + u(k,j,i-1) - gu
     4670                   flux_l_u(k,j,tn) = u_comp_l * (                             &
     4671                                    ( 37.0_wp * ibit2 * adv_mom_5              &
     4672                                 +     7.0_wp * ibit1 * adv_mom_3              &
     4673                                 +              ibit0 * adv_mom_1              &
     4674                                    ) *                                        &
     4675                                                ( u(k,j,i)   + u(k,j,i-1) )    &
     4676                             -      (  8.0_wp * ibit2 * adv_mom_5              &
     4677                                 +              ibit1 * adv_mom_3              &
     4678                                    ) *                                        &
     4679                                                ( u(k,j,i+1) + u(k,j,i-2) )    &
     4680                             +      (           ibit2 * adv_mom_5              &
     4681                                    ) *                                        &
     4682                                                ( u(k,j,i+2) + u(k,j,i-3) )    &
     4683                                                 )
     4684
     4685                    diss_l_u(k,j,tn) = - ABS( u_comp_l ) * (                   &
     4686                                    ( 10.0_wp * ibit2 * adv_mom_5              &
     4687                                 +     3.0_wp * ibit1 * adv_mom_3              &
     4688                                 +              ibit0  * adv_mom_1             &
     4689                                    ) *                                        &
     4690                                              ( u(k,j,i)   - u(k,j,i-1) )      &
     4691                             -      (  5.0_wp * ibit2 * adv_mom_5              &
     4692                                 +              ibit1 * adv_mom_3              &
     4693                                    ) *                                        &
     4694                                              ( u(k,j,i+1) - u(k,j,i-2) )      &
     4695                             +      (           ibit2 * adv_mom_5              &
     4696                                    ) *                                        &
     4697                                              ( u(k,j,i+2) - u(k,j,i-3) )      &
     4698                                                           )
     4699
     4700                ENDDO
     4701
     4702                DO  k = nzb_max_l+1, nzt
     4703
     4704                   u_comp_l         = u(k,j,i) + u(k,j,i-1) - gu
     4705                   flux_l_u(k,j,tn) = u_comp_l * (                             &
     4706                                   37.0_wp * ( u(k,j,i)   + u(k,j,i-1)   )     &
     4707                                 -  8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) )       &
     4708                                 +           ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_5
     4709                   diss_l_u(k,j,tn) = - ABS(u_comp_l) * (                      &
     4710                                   10.0_wp * ( u(k,j,i)   - u(k,j,i-1)   )     &
     4711                                 -  5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) )       &
     4712                                 +           ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_5
     4713
     4714                ENDDO
     4715
     4716             ENDIF
    47644717#endif
    47654718
    47664719!
    4767 !--       Computation of interior fluxes and tendency terms
    4768           DO  j = nys, nyn
    4769 
    4770              flux_d    = 0.0_wp
    4771              diss_d    = 0.0_wp
    4772 
     4720!--          Now compute the fluxes for the horizontal and parts.
    47734721             DO  k = nzb+1, nzb_max_l
    47744722
     
    47774725                ibit0 = REAL( IBITS(advc_flags_m(k,j,i),0,1), KIND = wp )
    47784726
    4779                 u_comp = u(k,j,i+1) + u(k,j,i)
    4780                 flux_r = ( u_comp - gu ) * (                                   &
    4781                           ( 37.0_wp * ibit2 * adv_mom_5                        &
    4782                        +     7.0_wp * ibit1 * adv_mom_3                        &
    4783                        +              ibit0 * adv_mom_1                       &
    4784                           ) *                                                  &
    4785                                  ( u(k,j,i+1) + u(k,j,i)   )                   &
    4786                    -      (  8.0_wp * ibit2 * adv_mom_5                        &
    4787                        +              ibit1 * adv_mom_3                        &
    4788                           ) *                                                  &
    4789                                  ( u(k,j,i+2) + u(k,j,i-1) )                   &
    4790                    +      (           ibit2 * adv_mom_5                        &
    4791                           ) *                                                  &
    4792                                  ( u(k,j,i+3) + u(k,j,i-2) )                   &
    4793                                                  )                           
    4794                                                                              
    4795                 diss_r = - ABS( u_comp - gu ) * (                              &
    4796                           ( 10.0_wp * ibit2 * adv_mom_5                        &
    4797                        +     3.0_wp * ibit1 * adv_mom_3                        &
    4798                        +              ibit0 * adv_mom_1                       &
    4799                           ) *                                                  &
    4800                                  ( u(k,j,i+1) - u(k,j,i)  )                    &
    4801                    -      (  5.0_wp * ibit2 * adv_mom_5                        &
    4802                        +              ibit1 * adv_mom_3                        &
    4803                           ) *                                                  &
    4804                                  ( u(k,j,i+2) - u(k,j,i-1) )                   &
    4805                    +      (           ibit2 * adv_mom_5                        &
    4806                           ) *                                                  &
    4807                                  ( u(k,j,i+3) - u(k,j,i-2) )                   &
    4808                                                      )
     4727                u_comp(k) = u(k,j,i+1) + u(k,j,i)
     4728                flux_r(k) = ( u_comp(k) - gu ) * (                             &
     4729                           ( 37.0_wp * ibit2 * adv_mom_5                       &
     4730                        +     7.0_wp * ibit1 * adv_mom_3                       &
     4731                        +              ibit0 * adv_mom_1                       &
     4732                           ) *                                                 &
     4733                                          ( u(k,j,i+1) + u(k,j,i)   )          &
     4734                    -      (  8.0_wp * ibit2 * adv_mom_5                       &
     4735                        +              ibit1 * adv_mom_3                       &
     4736                           ) *                                                 &
     4737                                          ( u(k,j,i+2) + u(k,j,i-1) )          &
     4738                    +      (           ibit2 * adv_mom_5                       &
     4739                           ) *                                                 &
     4740                                          ( u(k,j,i+3) + u(k,j,i-2) )          &
     4741                                                 )
     4742
     4743                diss_r(k) = - ABS( u_comp(k) - gu ) * (                        &
     4744                           ( 10.0_wp * ibit2 * adv_mom_5                       &
     4745                        +     3.0_wp * ibit1 * adv_mom_3                       &
     4746                        +              ibit0 * adv_mom_1                       &
     4747                           ) *                                                 &
     4748                                          ( u(k,j,i+1) - u(k,j,i)   )          &
     4749                    -      (  5.0_wp * ibit2 * adv_mom_5                       &
     4750                        +              ibit1 * adv_mom_3                       &
     4751                           ) *                                                 &
     4752                                          ( u(k,j,i+2) - u(k,j,i-1) )          &
     4753                    +      (           ibit2 * adv_mom_5                       &
     4754                           ) *                                                 &
     4755                                          ( u(k,j,i+3) - u(k,j,i-2) )          &
     4756                                                      )
    48094757
    48104758#ifdef _OPENACC
     
    48154763                ibit0_l = REAL( IBITS(advc_flags_m(k,j,i-1),0,1), KIND = wp )
    48164764
    4817                 u_comp_l = u(k,j,i) + u(k,j,i-1) - gu
    4818                 flux_l   = u_comp_l * (                                        &
     4765                u_comp_l           = u(k,j,i) + u(k,j,i-1) - gu
     4766                flux_l_u(k,j,tn)   = u_comp_l * (                              &
    48194767                                       ( 37.0_wp * ibit2_l * adv_mom_5         &
    48204768                                    +     7.0_wp * ibit1_l * adv_mom_3         &
    4821                                     +              ibit0_l  * adv_mom_1        &
     4769                                    +              ibit0_l * adv_mom_1         &
    48224770                                       ) *                                     &
    48234771                                     ( u(k,j,i)   + u(k,j,i-1) )               &
     
    48294777                                       ) *                                     &
    48304778                                     ( u(k,j,i+2) + u(k,j,i-3) )               &
    4831                                                    )
    4832 
    4833                 diss_l   = - ABS( u_comp_l ) * (                               &
     4779                                                )
     4780
     4781                diss_l_u(k,j,tn)   = - ABS( u_comp_l ) * (                     &
    48344782                                       ( 10.0_wp * ibit2_l * adv_mom_5         &
    48354783                                    +     3.0_wp * ibit1_l * adv_mom_3         &
     
    48444792                                       ) *                                     &
    48454793                                     ( u(k,j,i+2) - u(k,j,i-3) )               &
    4846                                                              )
    4847 #else
    4848                 flux_l = swap_flux_x_local_u(k,j)
    4849                 diss_l = swap_diss_x_local_u(k,j)
     4794                                                         )
    48504795#endif
     4796
    48514797
    48524798                ibit5 = REAL( IBITS(advc_flags_m(k,j,i),5,1), KIND = wp )
     
    48544800                ibit3 = REAL( IBITS(advc_flags_m(k,j,i),3,1), KIND = wp )
    48554801
    4856                 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv
    4857                 flux_n = v_comp * (                                            &
    4858                           ( 37.0_wp * ibit5 * adv_mom_5                        &
    4859                        +     7.0_wp * ibit4 * adv_mom_3                        &
    4860                        +              ibit3 * adv_mom_1                        &
    4861                           ) *                                                  &
    4862                                  ( u(k,j+1,i) + u(k,j,i)   )                   &
    4863                    -      (  8.0_wp * ibit5 * adv_mom_5                        &
    4864                        +              ibit4 * adv_mom_3                        &
    4865                           ) *                                                  &
    4866                                  ( u(k,j+2,i) + u(k,j-1,i) )                   &
    4867                    +      (           ibit5 * adv_mom_5                        &
    4868                           ) *                                                  &
    4869                                  ( u(k,j+3,i) + u(k,j-2,i) )                   &
    4870                                                  )                           
    4871                                                                              
    4872                 diss_n = - ABS ( v_comp ) * (                                  &
    4873                           ( 10.0_wp * ibit5 * adv_mom_5                        &
    4874                        +     3.0_wp * ibit4 * adv_mom_3                        &
    4875                        +              ibit3 * adv_mom_1                        &
    4876                           ) *                                                  &
    4877                                  ( u(k,j+1,i) - u(k,j,i)  )                    &
    4878                    -      (  5.0_wp * ibit5 * adv_mom_5                        &
    4879                        +              ibit4 * adv_mom_3                        &
    4880                           ) *                                                  &
    4881                                  ( u(k,j+2,i) - u(k,j-1,i) )                   &
    4882                    +      (           ibit5 * adv_mom_5                        &
    4883                           ) *                                                  &
    4884                                  ( u(k,j+3,i) - u(k,j-2,i) )                   &
    4885                                                       )
     4802                v_comp(k) = v(k,j+1,i) + v(k,j+1,i-1) - gv
     4803                flux_n(k) = v_comp(k) * (                                      &
     4804                           ( 37.0_wp * ibit5 * adv_mom_5                       &
     4805                        +     7.0_wp * ibit4 * adv_mom_3                       &
     4806                        +              ibit3 * adv_mom_1                       &
     4807                           ) *                                                 &
     4808                                          ( u(k,j+1,i) + u(k,j,i)   )          &
     4809                    -      (  8.0_wp * ibit5 * adv_mom_5                       &
     4810                        +              ibit4 * adv_mom_3                       &
     4811                           ) *                                                 &
     4812                                          ( u(k,j+2,i) + u(k,j-1,i) )          &
     4813                    +      (           ibit5 * adv_mom_5                       &
     4814                           ) *                                                 &
     4815                                          ( u(k,j+3,i) + u(k,j-2,i) )          &
     4816                                        )
     4817
     4818                diss_n(k) = - ABS ( v_comp(k) ) * (                            &
     4819                           ( 10.0_wp * ibit5 * adv_mom_5                       &
     4820                        +     3.0_wp * ibit4 * adv_mom_3                       &
     4821                        +              ibit3 * adv_mom_1                       &
     4822                           ) *                                                 &
     4823                                          ( u(k,j+1,i) - u(k,j,i)   )          &
     4824                    -      (  5.0_wp * ibit5 * adv_mom_5                       &
     4825                        +              ibit4 * adv_mom_3                       &
     4826                           ) *                                                 &
     4827                                          ( u(k,j+2,i) - u(k,j-1,i) )          &
     4828                    +      (           ibit5 * adv_mom_5                       &
     4829                           ) *                                                 &
     4830                                          ( u(k,j+3,i) - u(k,j-2,i) )          &
     4831                                                  )
    48864832
    48874833#ifdef _OPENACC
     
    48924838                ibit3_s = REAL( IBITS(advc_flags_m(k,j-1,i),3,1), KIND = wp )
    48934839
    4894                 v_comp_s = v(k,j,i) + v(k,j,i-1) - gv
    4895                 flux_s   = v_comp_s * (                                        &
     4840                v_comp_s         = v(k,j,i) + v(k,j,i-1) - gv
     4841                flux_s_u(k,tn)   = v_comp_s * (                                &
    48964842                                   ( 37.0_wp * ibit5_s * adv_mom_5             &
    48974843                                +     7.0_wp * ibit4_s * adv_mom_3             &
     
    49064852                               ) *                                             &
    49074853                                     ( u(k,j+2,i) + u(k,j-3,i) )               &
    4908                                                )
    4909 
    4910                 diss_s   = - ABS ( v_comp_s ) * (                              &
     4854                                              )
     4855
     4856                diss_s_u(k,tn)   = - ABS ( v_comp_s ) * (                      &
    49114857                                   ( 10.0_wp * ibit5_s * adv_mom_5             &
    49124858                                +     3.0_wp * ibit4_s * adv_mom_3             &
     
    49214867                                   ) *                                         &
    49224868                                     ( u(k,j+2,i) - u(k,j-3,i) )               &
    4923                                                          )
    4924 #else
    4925                 flux_s = swap_flux_y_local_u(k)
    4926                 diss_s = swap_diss_y_local_u(k)
     4869                                                        )
    49274870#endif
    4928 
     4871             ENDDO
     4872
     4873             DO  k = nzb_max_l+1, nzt
     4874
     4875                u_comp(k) = u(k,j,i+1) + u(k,j,i)
     4876                flux_r(k) = ( u_comp(k) - gu ) * (                             &
     4877                               37.0_wp * ( u(k,j,i+1) + u(k,j,i)   )           &
     4878                             -  8.0_wp * ( u(k,j,i+2) + u(k,j,i-1) )           &
     4879                             +           ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_5
     4880                diss_r(k) = - ABS( u_comp(k) - gu ) * (                        &
     4881                               10.0_wp * ( u(k,j,i+1) - u(k,j,i)   )           &
     4882                             -  5.0_wp * ( u(k,j,i+2) - u(k,j,i-1) )           &
     4883                             +           ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_5
     4884#ifdef _OPENACC
     4885!
     4886!--             Recompute the left fluxes.
     4887                u_comp_l           = u(k,j,i) + u(k,j,i-1) - gu
     4888                flux_l_u(k,j,tn)   = u_comp_l * (                              &
     4889                             37.0_wp * ( u(k,j,i) + u(k,j,i-1)   )             &
     4890                           -  8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) )             &
     4891                           +           ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_5
     4892                diss_l_u(k,j,tn)   = - ABS(u_comp_l) * (                       &
     4893                             10.0_wp * ( u(k,j,i) - u(k,j,i-1)   )             &
     4894                           -  5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) )             &
     4895                           +           ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_5
     4896
     4897#endif
     4898                v_comp(k) = v(k,j+1,i) + v(k,j+1,i-1) - gv
     4899                flux_n(k) = v_comp(k) * (                                      &
     4900                               37.0_wp * ( u(k,j+1,i) + u(k,j,i)   )           &
     4901                             -  8.0_wp * ( u(k,j+2,i) + u(k,j-1,i) )           &
     4902                             +           ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_5
     4903                diss_n(k) = - ABS( v_comp(k) ) * (                             &
     4904                               10.0_wp * ( u(k,j+1,i) - u(k,j,i)   )           &
     4905                             -  5.0_wp * ( u(k,j+2,i) - u(k,j-1,i) )           &
     4906                             +           ( u(k,j+3,i) - u(k,j-2,i) ) ) * adv_mom_5
     4907#ifdef _OPENACC
     4908!
     4909!--             Recompute the south fluxes.
     4910                v_comp_s         = v(k,j,i) + v(k,j,i-1) - gv
     4911                flux_s_u(k,tn)   = v_comp_s * (                                &
     4912                           37.0_wp * ( u(k,j,i) + u(k,j-1,i)   )               &
     4913                         -  8.0_wp * ( u(k,j+1,i) + u(k,j-2,i) )               &
     4914                         +           ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5
     4915                diss_s_u(k,tn)   = - ABS( v_comp_s ) * (                       &
     4916                           10.0_wp * ( u(k,j,i) - u(k,j-1,i)   )               &
     4917                         -  5.0_wp * ( u(k,j+1,i) - u(k,j-2,i) )               &
     4918                         +           ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_5
     4919#endif
     4920             ENDDO
     4921!
     4922!--          Now, compute vertical fluxes. Split loop into a part treating the
     4923!--          lowest 2 grid points with indirect indexing, a main loop without
     4924!--          indirect indexing, and a loop for the uppermost 2 grip points with
     4925!--          indirect indexing. This allows better vectorization for the main loop.
     4926!--          First, compute the flux at model surface, which need has to be
     4927!--          calculated explicetely for the tendency at
     4928!--          the first w-level. For topography wall this is done implicitely by
     4929!--          advc_flags_m.
     4930             flux_t(nzb) = 0.0_wp
     4931             diss_t(nzb) = 0.0_wp
     4932             w_comp(nzb) = 0.0_wp
     4933             DO  k = nzb+1, nzb+2
    49294934!
    49304935!--             k index has to be modified near bottom and top, else array
     
    49354940
    49364941                k_ppp = k + 3 * ibit8
    4937                 k_pp  = k + 2 * ( 1 - ibit6  )
     4942                k_pp  = k + 2 * ( 1 - ibit6 )
    49384943                k_mm  = k - 2 * ibit8
    49394944
    4940                 w_comp = w(k,j,i) + w(k,j,i-1)
    4941                 flux_t = w_comp * rho_air_zw(k) * (                            &
    4942                           ( 37.0_wp * ibit8 * adv_mom_5                        &
    4943                        +     7.0_wp * ibit7 * adv_mom_3                        &
    4944                        +              ibit6 * adv_mom_1                        &
    4945                           ) *                                                  &
    4946                              ( u(k+1,j,i)  + u(k,j,i)     )                    &
    4947                    -      (  8.0_wp * ibit8 * adv_mom_5                        &
    4948                        +              ibit7 * adv_mom_3                        &
    4949                           ) *                                                  &
    4950                              ( u(k_pp,j,i) + u(k-1,j,i)   )                    &
    4951                    +      (           ibit8 * adv_mom_5                        &
    4952                           ) *                                                  &
    4953                              ( u(k_ppp,j,i) + u(k_mm,j,i) )                    &
    4954                                       )                                       
    4955                                                                              
    4956                 diss_t = - ABS( w_comp ) * rho_air_zw(k) * (                   &
    4957                           ( 10.0_wp * ibit8 * adv_mom_5                        &
    4958                        +     3.0_wp * ibit7 * adv_mom_3                        &
    4959                        +              ibit6 * adv_mom_1                        &
    4960                           ) *                                                  &
    4961                              ( u(k+1,j,i)   - u(k,j,i)    )                    &
    4962                    -      (  5.0_wp * ibit8 * adv_mom_5                        &
    4963                        +              ibit7 * adv_mom_3                        &
    4964                           ) *                                                  &
    4965                              ( u(k_pp,j,i)  - u(k-1,j,i)  )                    &
    4966                    +      (           ibit8 * adv_mom_5                        &
    4967                            ) *                                                 &
    4968                              ( u(k_ppp,j,i) - u(k_mm,j,i) )                    &
    4969                                               )
    4970 !
    4971 !--             Calculate the divergence of the velocity field. A respective
    4972 !--             correction is needed to overcome numerical instabilities caused
    4973 !--             by a not sufficient reduction of divergences near topography.
    4974                 div = ( ( u_comp * ( ibit0 + ibit1 + ibit2 )                   &
    4975                 - ( u(k,j,i)   + u(k,j,i-1)   )                                &
    4976                                     * (                                        &
    4977                     REAL( IBITS(advc_flags_m(k,j,i-1),0,1),  KIND = wp )       &
    4978                   + REAL( IBITS(advc_flags_m(k,j,i-1),1,1), KIND = wp )        &
    4979                   + REAL( IBITS(advc_flags_m(k,j,i-1),2,1), KIND = wp )        &
    4980                                       )                                        &
    4981                   ) * ddx                                                      &
    4982                +  ( ( v_comp + gv ) * ( ibit3 + ibit4 + ibit5 )                &
    4983                   - ( v(k,j,i)   + v(k,j,i-1 )  )                              &
    4984                                     * (                                        &
    4985                      REAL( IBITS(advc_flags_m(k,j-1,i),3,1), KIND = wp )       &
    4986                    + REAL( IBITS(advc_flags_m(k,j-1,i),4,1), KIND = wp )       &
    4987                    + REAL( IBITS(advc_flags_m(k,j-1,i),5,1), KIND = wp )       &
    4988                                       )                                        &
    4989                   ) * ddy                                                      &
    4990                +  ( w_comp * rho_air_zw(k) * ( ibit6 + ibit7 + ibit8 )         &
    4991                 - ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1)              &
    4992                                     * (                                        &
    4993                      REAL( IBITS(advc_flags_m(k-1,j,i),6,1), KIND = wp )       &
    4994                    + REAL( IBITS(advc_flags_m(k-1,j,i),7,1), KIND = wp )       &
    4995                    + REAL( IBITS(advc_flags_m(k-1,j,i),8,1), KIND = wp )       &
    4996                                       )                                        & 
    4997                   ) * drho_air(k) * ddzw(k)                                    &
    4998                 ) * 0.5_wp
    4999 
    5000 
    5001 
    5002                 tend(k,j,i) = tend(k,j,i) - (                                  &
    5003                  ( ( flux_r + diss_r )                                         &
    5004                -   ( flux_l + diss_l ) ) * ddx                                 &
    5005                + ( ( flux_n + diss_n )                                         &
    5006                -   ( flux_s + diss_s ) ) * ddy                                 &
    5007                + ( ( flux_t + diss_t )                                         &
    5008                -   ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k)               &
    5009                                            ) + div * u(k,j,i)
    5010 
    5011 #ifndef _OPENACC
    5012                 swap_flux_x_local_u(k,j) = flux_r
    5013                 swap_diss_x_local_u(k,j) = diss_r
    5014                 swap_flux_y_local_u(k)   = flux_n
    5015                 swap_diss_y_local_u(k)   = diss_n
    5016 #endif
    5017                 flux_d                   = flux_t
    5018                 diss_d                   = diss_t
    5019 !
    5020 !--             Statistical Evaluation of u'u'. The factor has to be applied
    5021 !--             for right evaluation when gallilei_trans = .T. .
    5022                 !$ACC ATOMIC
    5023                 sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                      &
    5024                 + ( flux_r                                                     &
    5025                     * ( u_comp - 2.0_wp * hom(k,1,1,0)                   )     &
    5026                     / ( u_comp - gu + SIGN( 1.0E-20_wp, u_comp - gu )    )     &
    5027                   + diss_r                                                     &
    5028                     *   ABS( u_comp - 2.0_wp * hom(k,1,1,0)              )     &
    5029                     / ( ABS( u_comp - gu ) + 1.0E-20_wp                  )     &
    5030                   ) *   weight_substep(intermediate_timestep_count)
    5031 !
    5032 !--             Statistical Evaluation of w'u'.
    5033                 !$ACC ATOMIC
    5034                 sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                    &
    5035                 + ( flux_t                                                     &
    5036                     * ( w_comp - 2.0_wp * hom(k,1,3,0)                   )     &
    5037                     / ( w_comp + SIGN( 1.0E-20_wp, w_comp )              )     &
    5038                   + diss_t                                                     &
    5039                     *   ABS( w_comp - 2.0_wp * hom(k,1,3,0)              )     &
    5040                     / ( ABS( w_comp ) + 1.0E-20_wp                       )     &
    5041                   ) *   weight_substep(intermediate_timestep_count)
    5042 
     4945                w_comp(k) = w(k,j,i) + w(k,j,i-1)
     4946                flux_t(k) = w_comp(k) * rho_air_zw(k) * (                      &
     4947                           ( 37.0_wp * ibit8 * adv_mom_5                       &
     4948                        +     7.0_wp * ibit7 * adv_mom_3                       &
     4949                        +              ibit6 * adv_mom_1                       &
     4950                           ) *                                                 &
     4951                                      ( u(k+1,j,i)   + u(k,j,i)    )           &
     4952                    -      (  8.0_wp * ibit8 * adv_mom_5                       &
     4953                        +              ibit7 * adv_mom_3                       &
     4954                           ) *                                                 &
     4955                                      ( u(k_pp,j,i)  + u(k-1,j,i)  )           &
     4956                    +      (           ibit8 * adv_mom_5                       &
     4957                           ) *                                                 &
     4958                                      ( u(k_ppp,j,i) + u(k_mm,j,i) )           &
     4959                                                        )
     4960
     4961                diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (             &
     4962                           ( 10.0_wp * ibit8 * adv_mom_5                       &
     4963                        +     3.0_wp * ibit7 * adv_mom_3                       &
     4964                        +              ibit6 * adv_mom_1                       &
     4965                           ) *                                                 &
     4966                                      ( u(k+1,j,i)   - u(k,j,i)    )           &
     4967                    -      (  5.0_wp * ibit8 * adv_mom_5                       &
     4968                        +              ibit7 * adv_mom_3                       &
     4969                           ) *                                                 &
     4970                                      ( u(k_pp,j,i)  - u(k-1,j,i)  )           &
     4971                    +      (           ibit8 * adv_mom_5                       &
     4972                           ) *                                                 &
     4973                                      ( u(k_ppp,j,i) - u(k_mm,j,i) )           &
     4974                                                                 )
    50434975             ENDDO
    50444976
    5045              DO  k = nzb_max_l+1, nzt
    5046 
    5047                 u_comp = u(k,j,i+1) + u(k,j,i)
    5048                 flux_r = ( u_comp - gu ) * (                                   &
    5049                          37.0_wp * ( u(k,j,i+1) + u(k,j,i)   )                 &
    5050                        -  8.0_wp * ( u(k,j,i+2) + u(k,j,i-1) )                 &
    5051                        +           ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_5
    5052                 diss_r = - ABS( u_comp - gu ) * (                              &
    5053                          10.0_wp * ( u(k,j,i+1) - u(k,j,i)   )                 &
    5054                        -  5.0_wp * ( u(k,j,i+2) - u(k,j,i-1) )                 &
    5055                        +           ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_5
    5056 
    5057 #ifdef _OPENACC
    5058 !
    5059 !--             Recompute the left fluxes.
    5060                 u_comp_l = u(k,j,i) + u(k,j,i-1) - gu
    5061                 flux_l   = u_comp_l * (                                        &
    5062                              37.0_wp * ( u(k,j,i) + u(k,j,i-1)   )             &
    5063                            -  8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) )             &
    5064                            +           ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_5
    5065                 diss_l   = - ABS(u_comp_l) * (                                 &
    5066                              10.0_wp * ( u(k,j,i) - u(k,j,i-1)   )             &
    5067                            -  5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) )             &
    5068                            +           ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_5
    5069 #else
    5070                 flux_l = swap_flux_x_local_u(k,j)
    5071                 diss_l = swap_diss_x_local_u(k,j)
    5072 #endif
    5073 
    5074                 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv
    5075                 flux_n = v_comp * (                                            &
    5076                          37.0_wp * ( u(k,j+1,i) + u(k,j,i)   )                 &
    5077                        -  8.0_wp * ( u(k,j+2,i) + u(k,j-1,i) )                 &
    5078                        +           ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_5
    5079                 diss_n = - ABS( v_comp ) * (                                   &
    5080                          10.0_wp * ( u(k,j+1,i) - u(k,j,i)   )                 &
    5081                        -  5.0_wp * ( u(k,j+2,i) - u(k,j-1,i) )                 &
    5082                        +           ( u(k,j+3,i) - u(k,j-2,i) ) ) * adv_mom_5
    5083 
    5084 #ifdef _OPENACC
    5085 !
    5086 !--             Recompute the south fluxes.
    5087                 v_comp_s = v(k,j,i) + v(k,j,i-1) - gv
    5088                 flux_s   = v_comp_s * (                                        &
    5089                            37.0_wp * ( u(k,j,i) + u(k,j-1,i)   )               &
    5090                          -  8.0_wp * ( u(k,j+1,i) + u(k,j-2,i) )               &
    5091                          +           ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5
    5092                 diss_s   = - ABS( v_comp_s ) * (                               &
    5093                            10.0_wp * ( u(k,j,i) - u(k,j-1,i)   )               &
    5094                          -  5.0_wp * ( u(k,j+1,i) - u(k,j-2,i) )               &
    5095                          +           ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_5
    5096 #else
    5097                 flux_s = swap_flux_y_local_u(k)
    5098                 diss_s = swap_diss_y_local_u(k)
    5099 #endif
    5100 
     4977             DO  k = nzb+3, nzt-2
     4978
     4979                ibit8 = REAL( IBITS(advc_flags_m(k,j,i),8,1), KIND = wp )
     4980                ibit7 = REAL( IBITS(advc_flags_m(k,j,i),7,1), KIND = wp )
     4981                ibit6 = REAL( IBITS(advc_flags_m(k,j,i),6,1), KIND = wp )
     4982
     4983                w_comp(k) = w(k,j,i) + w(k,j,i-1)
     4984                flux_t(k) = w_comp(k) * rho_air_zw(k) * (                      &
     4985                           ( 37.0_wp * ibit8 * adv_mom_5                       &
     4986                        +     7.0_wp * ibit7 * adv_mom_3                       &
     4987                        +              ibit6 * adv_mom_1                       &
     4988                           ) *                                                 &
     4989                                      ( u(k+1,j,i)  + u(k,j,i)     )           &
     4990                    -      (  8.0_wp * ibit8 * adv_mom_5                       &
     4991                        +              ibit7 * adv_mom_3                       &
     4992                           ) *                                                 &
     4993                                      ( u(k+2,j,i) + u(k-1,j,i)   )            &
     4994                    +      (           ibit8 * adv_mom_5                       &
     4995                           ) *                                                 &
     4996                                      ( u(k+3,j,i) + u(k-2,j,i) )              &
     4997                                                        )
     4998
     4999                diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (             &
     5000                           ( 10.0_wp * ibit8 * adv_mom_5                       &
     5001                        +     3.0_wp * ibit7 * adv_mom_3                       &
     5002                        +              ibit6 * adv_mom_1                       &
     5003                           ) *                                                 &
     5004                                      ( u(k+1,j,i)  - u(k,j,i)    )            &
     5005                    -      (  5.0_wp * ibit8 * adv_mom_5                       &
     5006                        +              ibit7 * adv_mom_3                       &
     5007                           ) *                                                 &
     5008                                      ( u(k+2,j,i)  - u(k-1,j,i)  )            &
     5009                    +      (           ibit8 * adv_mom_5                       &
     5010                           ) *                                                 &
     5011                                      ( u(k+3,j,i) - u(k-2,j,i)   )            &
     5012                                                                 )
     5013             ENDDO
     5014
     5015             DO  k = nzt-1, nzt-symmetry_flag
    51015016!
    51025017!--             k index has to be modified near bottom and top, else array
     
    51075022
    51085023                k_ppp = k + 3 * ibit8
    5109                 k_pp  = k + 2 * ( 1 - ibit6  )
     5024                k_pp  = k + 2 * ( 1 - ibit6 )
    51105025                k_mm  = k - 2 * ibit8
    51115026
    5112                 w_comp = w(k,j,i) + w(k,j,i-1)
    5113                 flux_t = w_comp * rho_air_zw(k) * (                            &
    5114                           ( 37.0_wp * ibit8 * adv_mom_5                        &
    5115                        +     7.0_wp * ibit7 * adv_mom_3                        &
    5116                        +              ibit6 * adv_mom_1                        &
    5117                           ) *                                                  &
    5118                              ( u(k+1,j,i)  + u(k,j,i)     )                    &
    5119                    -      (  8.0_wp * ibit8 * adv_mom_5                        &
    5120                        +              ibit7 * adv_mom_3                        &
    5121                           ) *                                                  &
    5122                              ( u(k_pp,j,i) + u(k-1,j,i)   )                    &
    5123                    +      (           ibit8 * adv_mom_5                        &
    5124                           ) *                                                  &
    5125                              ( u(k_ppp,j,i) + u(k_mm,j,i) )                    &
    5126                                       )
    5127 
    5128                 diss_t = - ABS( w_comp ) * rho_air_zw(k) * (                   &
    5129                           ( 10.0_wp * ibit8 * adv_mom_5                        &
    5130                        +     3.0_wp * ibit7 * adv_mom_3                        &
    5131                        +              ibit6 * adv_mom_1                        &
    5132                           ) *                                                  &
    5133                              ( u(k+1,j,i)   - u(k,j,i)    )                    &
    5134                    -      (  5.0_wp * ibit8 * adv_mom_5                        &
    5135                        +              ibit7 * adv_mom_3                        &
    5136                           ) *                                                  &
    5137                              ( u(k_pp,j,i)  - u(k-1,j,i)  )                    &
    5138                    +      (           ibit8 * adv_mom_5                        &
    5139                            ) *                                                 &
    5140                              ( u(k_ppp,j,i) - u(k_mm,j,i) )                    &
    5141                                               )
     5027                w_comp(k) = w(k,j,i) + w(k,j,i-1)
     5028                flux_t(k) = w_comp(k) * rho_air_zw(k) * (                      &
     5029                           ( 37.0_wp * ibit8 * adv_mom_5                       &
     5030                        +     7.0_wp * ibit7 * adv_mom_3                       &
     5031                        +              ibit6 * adv_mom_1                       &
     5032                           ) *                                                 &
     5033                                      ( u(k+1,j,i)   + u(k,j,i)    )           &
     5034                    -      (  8.0_wp * ibit8 * adv_mom_5                       &
     5035                        +              ibit7 * adv_mom_3                       &
     5036                           ) *                                                 &
     5037                                      ( u(k_pp,j,i)  + u(k-1,j,i)  )           &
     5038                    +      (           ibit8 * adv_mom_5                       &
     5039                           ) *                                                 &
     5040                                      ( u(k_ppp,j,i) + u(k_mm,j,i) )           &
     5041                                                        )
     5042
     5043                diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (             &
     5044                           ( 10.0_wp * ibit8 * adv_mom_5                       &
     5045                        +     3.0_wp * ibit7 * adv_mom_3                       &
     5046                        +              ibit6 * adv_mom_1                       &
     5047                           ) *                                                 &
     5048                                      ( u(k+1,j,i)   - u(k,j,i)    )           &
     5049                    -      (  5.0_wp * ibit8 * adv_mom_5                       &
     5050                        +              ibit7 * adv_mom_3                       &
     5051                           ) *                                                 &
     5052                                      ( u(k_pp,j,i)  - u(k-1,j,i)  )           &
     5053                    +      (           ibit8 * adv_mom_5                       &
     5054                           ) *                                                 &
     5055                                      ( u(k_ppp,j,i) - u(k_mm,j,i) )           &
     5056                                                                 )
     5057             ENDDO
     5058!
     5059!--          Set resolved/turbulent flux at model top to zero (w-level). In case that
     5060!--          a symmetric behavior between bottom and top shall be guaranteed (closed
     5061!--          channel flow), the flux at nzt is also set to zero.
     5062             IF ( symmetry_flag == 1 ) THEN
     5063                flux_t(nzt) = 0.0_wp
     5064                diss_t(nzt) = 0.0_wp
     5065                w_comp(nzt) = 0.0_wp
     5066             ENDIF
     5067             flux_t(nzt+1) = 0.0_wp
     5068             diss_t(nzt+1) = 0.0_wp
     5069             w_comp(nzt+1) = 0.0_wp
     5070
     5071             DO  k = nzb+1, nzb_max_l
     5072
     5073                flux_d    = flux_t(k-1)
     5074                diss_d    = diss_t(k-1)
     5075
     5076                ibit2 = REAL( IBITS(advc_flags_m(k,j,i),2,1), KIND = wp )
     5077                ibit1 = REAL( IBITS(advc_flags_m(k,j,i),1,1), KIND = wp )
     5078                ibit0 = REAL( IBITS(advc_flags_m(k,j,i),0,1), KIND = wp )
     5079
     5080                ibit5 = REAL( IBITS(advc_flags_m(k,j,i),5,1), KIND = wp )
     5081                ibit4 = REAL( IBITS(advc_flags_m(k,j,i),4,1), KIND = wp )
     5082                ibit3 = REAL( IBITS(advc_flags_m(k,j,i),3,1), KIND = wp )
     5083
     5084                ibit8 = REAL( IBITS(advc_flags_m(k,j,i),8,1), KIND = wp )
     5085                ibit7 = REAL( IBITS(advc_flags_m(k,j,i),7,1), KIND = wp )
     5086                ibit6 = REAL( IBITS(advc_flags_m(k,j,i),6,1), KIND = wp )
    51425087!
    51435088!--             Calculate the divergence of the velocity field. A respective
    5144 !--             correction is needed to overcome numerical instabilities caused
     5089!--             correction is needed to overcome numerical instabilities introduced
    51455090!--             by a not sufficient reduction of divergences near topography.
    5146                 div = ( ( u_comp      - ( u(k,j,i)   + u(k,j,i-1)   ) ) * ddx  &
    5147                      +  ( v_comp + gv - ( v(k,j,i)   + v(k,j,i-1 )  ) ) * ddy  &
    5148                      +  (   w_comp                      * rho_air_zw(k) -      &
    5149                           ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1)      &
    5150                         ) * drho_air(k) * ddzw(k)                              &
     5091                div = ( ( u_comp(k)       * ( ibit0 + ibit1 + ibit2 )            &
     5092                      - ( u(k,j,i)   + u(k,j,i-1)   )                            &
     5093                                          * (                                    &
     5094                           REAL( IBITS(advc_flags_m(k,j,i-1),0,1),  KIND = wp )  &
     5095                         + REAL( IBITS(advc_flags_m(k,j,i-1),1,1), KIND = wp )   &
     5096                         + REAL( IBITS(advc_flags_m(k,j,i-1),2,1), KIND = wp )   &
     5097                                            )                                    &
     5098                        ) * ddx                                                  &
     5099                     +  ( ( v_comp(k) + gv ) * ( ibit3 + ibit4 + ibit5 )         &
     5100                        - ( v(k,j,i)   + v(k,j,i-1 )  )                          &
     5101                                          * (                                    &
     5102                           REAL( IBITS(advc_flags_m(k,j-1,i),3,1), KIND = wp )   &
     5103                         + REAL( IBITS(advc_flags_m(k,j-1,i),4,1), KIND = wp )   &
     5104                         + REAL( IBITS(advc_flags_m(k,j-1,i),5,1), KIND = wp )   &
     5105                                            )                                    &
     5106                        ) * ddy                                                  &
     5107                     +  ( w_comp(k)   * rho_air_zw(k) * ( ibit6 + ibit7 + ibit8 )&
     5108                      -   w_comp(k-1) * rho_air_zw(k-1)                          &
     5109                                          * (                                    &
     5110                           REAL( IBITS(advc_flags_m(k-1,j,i),6,1), KIND = wp )   &
     5111                         + REAL( IBITS(advc_flags_m(k-1,j,i),7,1), KIND = wp )   &
     5112                         + REAL( IBITS(advc_flags_m(k-1,j,i),8,1), KIND = wp )   &
     5113                                            )                                    &
     5114                        ) * drho_air(k) * ddzw(k)                                &
    51515115                      ) * 0.5_wp
    51525116
    5153                 tend(k,j,i) = tend(k,j,i) - (                                  &
    5154                  ( ( flux_r + diss_r )                                         &
    5155                -   ( flux_l + diss_l ) ) * ddx                                 &
    5156                + ( ( flux_n + diss_n )                                         &
    5157                -   ( flux_s + diss_s ) ) * ddy                                 &
    5158                + ( ( flux_t + diss_t )                                         &
    5159                -   ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k)               &
    5160                                            ) + div * u(k,j,i)
    5161 
     5117                tend(k,j,i) = tend(k,j,i) - (                                    &
     5118                                  ( flux_r(k) + diss_r(k)                        &
     5119                                -   flux_l_u(k,j,tn) - diss_l_u(k,j,tn) ) * ddx  &
     5120                                + ( flux_n(k) + diss_n(k)                        &
     5121                                -   flux_s_u(k,tn) - diss_s_u(k,tn)     ) * ddy  &
     5122                                + ( ( flux_t(k) + diss_t(k) )                    &
     5123                                -   ( flux_d    + diss_d    )                    &
     5124                                                       ) * drho_air(k) * ddzw(k) &
     5125                                             ) + div * u(k,j,i)
    51625126#ifndef _OPENACC
    5163                 swap_flux_x_local_u(k,j) = flux_r
    5164                 swap_diss_x_local_u(k,j) = diss_r
    5165                 swap_flux_y_local_u(k)   = flux_n
    5166                 swap_diss_y_local_u(k)   = diss_n
     5127!
     5128!--             Swap fluxes. Note, in the OPENACC case these are computed again.
     5129                flux_l_u(k,j,tn) = flux_r(k)
     5130                diss_l_u(k,j,tn) = diss_r(k)
     5131                flux_s_u(k,tn)   = flux_n(k)
     5132                diss_s_u(k,tn)   = diss_n(k)
    51675133#endif
    5168                 flux_d                   = flux_t
    5169                 diss_d                   = diss_t
    5170 !
    5171 !--             Statistical Evaluation of u'u'. The factor has to be applied
    5172 !--             for right evaluation when gallilei_trans = .T. .
    5173                 !$ACC ATOMIC
    5174                 sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                      &
    5175                 + ( flux_r                                                     &
    5176                     * ( u_comp - 2.0_wp * hom(k,1,1,0)                   )     &
    5177                     / ( u_comp - gu + SIGN( 1.0E-20_wp, u_comp - gu )    )     &
    5178                   + diss_r                                                     &
    5179                     *   ABS( u_comp - 2.0_wp * hom(k,1,1,0)              )     &
    5180                     / ( ABS( u_comp - gu ) + 1.0E-20_wp                  )     &
    5181                   ) *   weight_substep(intermediate_timestep_count)
     5134!
     5135!--             Statistical Evaluation of u'u'. The factor has to be applied for
     5136!--             right evaluation when gallilei_trans = .T. .
     5137                sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                           &
     5138                      + ( flux_r(k)                                                 &
     5139                          * ( u_comp(k) - 2.0_wp * hom(k,1,1,0)                   ) &
     5140                          / ( u_comp(k) - gu + SIGN( 1.0E-20_wp, u_comp(k) - gu ) ) &
     5141                        + diss_r(k)                                                 &
     5142                          *   ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0)              ) &
     5143                          / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp                  ) &
     5144                        ) *   weight_substep(intermediate_timestep_count)
    51825145!
    51835146!--             Statistical Evaluation of w'u'.
    5184                 !$ACC ATOMIC
    5185                 sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                    &
    5186                 + ( flux_t                                                     &
    5187                     * ( w_comp - 2.0_wp * hom(k,1,3,0)                   )     &
    5188                     / ( w_comp + SIGN( 1.0E-20_wp, w_comp )              )     &
    5189                   + diss_t                                                     &
    5190                     *   ABS( w_comp - 2.0_wp * hom(k,1,3,0)              )     &
    5191                     / ( ABS( w_comp ) + 1.0E-20_wp                       )     &
    5192                   ) *   weight_substep(intermediate_timestep_count)
     5147                sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                         &
     5148                      + ( flux_t(k)                                                 &
     5149                          * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                   ) &
     5150                          / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )           ) &
     5151                        + diss_t(k)                                                 &
     5152                          *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)              ) &
     5153                          / ( ABS( w_comp(k) ) + 1.0E-20_wp                       ) &
     5154                        ) *   weight_substep(intermediate_timestep_count)
     5155             ENDDO
     5156
     5157             DO  k = nzb_max_l+1, nzt
     5158
     5159                flux_d    = flux_t(k-1)
     5160                diss_d    = diss_t(k-1)
     5161!
     5162!--             Calculate the divergence of the velocity field. A respective
     5163!--             correction is needed to overcome numerical instabilities introduced
     5164!--             by a not sufficient reduction of divergences near topography.
     5165                div = ( ( u_comp(k)       - ( u(k,j,i)   + u(k,j,i-1) ) ) * ddx      &
     5166                     +  ( v_comp(k) + gv  - ( v(k,j,i)   + v(k,j,i-1) ) ) * ddy      &
     5167                     +  ( w_comp(k)   * rho_air_zw(k)                                &
     5168                       -  w_comp(k-1) * rho_air_zw(k-1)                              &
     5169                        ) * drho_air(k) * ddzw(k)                                    &
     5170                      ) * 0.5_wp
     5171
     5172                tend(k,j,i) = tend(k,j,i) - (                                        &
     5173                                  ( flux_r(k) + diss_r(k)                            &
     5174                                -   flux_l_u(k,j,tn) - diss_l_u(k,j,tn) ) * ddx      &
     5175                                + ( flux_n(k) + diss_n(k)                            &
     5176                                -   flux_s_u(k,tn) - diss_s_u(k,tn)     ) * ddy      &
     5177                                + ( ( flux_t(k) + diss_t(k) )                        &
     5178                                -   ( flux_d    + diss_d    )                        &
     5179                                                          ) * drho_air(k) * ddzw(k)  &
     5180                                             ) + div * u(k,j,i)
     5181#ifndef _OPENACC
     5182                flux_l_u(k,j,tn) = flux_r(k)
     5183                diss_l_u(k,j,tn) = diss_r(k)
     5184                flux_s_u(k,tn)   = flux_n(k)
     5185                diss_s_u(k,tn)   = diss_n(k)
     5186#endif
     5187!
     5188!--             Statistical Evaluation of u'u'. The factor has to be applied for
     5189!--             right evaluation when gallilei_trans = .T. .
     5190                sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                            &
     5191                      + ( flux_r(k)                                                  &
     5192                          * ( u_comp(k) - 2.0_wp * hom(k,1,1,0)                   )  &
     5193                          / ( u_comp(k) - gu + SIGN( 1.0E-20_wp, u_comp(k) - gu ) )  &
     5194                        + diss_r(k)                                                  &
     5195                          *   ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0)              )  &
     5196                          / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp                  )  &
     5197                        ) *   weight_substep(intermediate_timestep_count)
     5198!
     5199!--             Statistical Evaluation of w'u'.
     5200                sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                          &
     5201                      + ( flux_t(k)                                                  &
     5202                          * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                   )  &
     5203                          / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )           )  &
     5204                        + diss_t(k)                                                  &
     5205                          *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)              )  &
     5206                          / ( ABS( w_comp(k) ) + 1.0E-20_wp                       )  &
     5207                        ) *   weight_substep(intermediate_timestep_count)
    51935208             ENDDO
    51945209          ENDDO
    51955210       ENDDO
    51965211
     5212       CALL cpu_log( log_point_s(68), 'advec_u_ws', 'stop' )
     5213
    51975214    END SUBROUTINE advec_u_ws
    5198    
     5215
    51995216
    52005217!------------------------------------------------------------------------------!
     
    52125229       INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
    52135230       INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
    5214        INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms 
     5231       INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
    52155232       INTEGER(iwp) ::  tn = 0    !< number of OpenMP thread
    5216        
     5233
    52175234       REAL(wp)    ::  ibit9 !< flag indicating 1st-order scheme along x-direction
    52185235       REAL(wp)    ::  ibit10 !< flag indicating 3rd-order scheme along x-direction
     
    52315248       REAL(wp)    ::  ibit14_s !< flag indicating 5th-order scheme along y-direction
    52325249#endif
    5233        REAL(wp)    ::  ibit15 !< flag indicating 1st-order scheme along z-direction
    5234        REAL(wp)    ::  ibit16 !< flag indicating 3rd-order scheme along z-direction
    5235        REAL(wp)    ::  ibit17 !< flag indicating 5th-order scheme along z-direction
    5236        REAL(wp)    ::  diss_d !< artificial dissipation term at grid box bottom
    5237        REAL(wp)    ::  div    !< diverence on v-grid
    5238        REAL(wp)    ::  flux_d !< artificial 6th-order flux at grid box bottom
    5239        REAL(wp)    ::  gu     !< Galilei-transformation velocity along x
    5240        REAL(wp)    ::  gv     !< Galilei-transformation velocity along y
    5241        REAL(wp)    ::  u_comp !< advection velocity along x
     5250       REAL(wp)    ::  ibit15   !< flag indicating 1st-order scheme along z-direction
     5251       REAL(wp)    ::  ibit16   !< flag indicating 3rd-order scheme along z-direction
     5252       REAL(wp)    ::  ibit17   !< flag indicating 5th-order scheme along z-direction
     5253       REAL(wp)    ::  diss_d   !< artificial dissipation term at grid box bottom
     5254       REAL(wp)    ::  div      !< diverence on v-grid
     5255       REAL(wp)    ::  flux_d   !< artificial 6th-order flux at grid box bottom
     5256       REAL(wp)    ::  gu       !< Galilei-transformation velocity along x
     5257       REAL(wp)    ::  gv       !< Galilei-transformation velocity along y
    52425258#ifdef _OPENACC
    5243        REAL(wp)    ::  u_comp_l !< advection velocity along x
     5259       REAL(wp)    ::  u_comp_l !< advection velocity along x at leftward side
     5260       REAL(wp)    ::  v_comp_s !< advection velocity along y at southward side
    52445261#endif
    5245        REAL(wp)    ::  w_comp !< advection velocity along z
    5246        
    5247        REAL(wp)    ::  diss_s !< discretized artificial dissipation at southward-side of the grid box
    5248        REAL(wp)    ::  flux_s !< discretized 6th-order flux at southward-side of the grid box
    5249 #ifndef _OPENACC
    5250        REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local_v !< discretized artificial dissipation at southward-side of the grid box
    5251        REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local_v !< discretized 6th-order flux at southward-side of the grid box
    5252 #endif
    5253        
    5254        REAL(wp)    ::  diss_l !< discretized artificial dissipation at leftward-side of the grid box
    5255        REAL(wp)    ::  flux_l !< discretized 6th-order flux at leftward-side of the grid box
    5256 #ifndef _OPENACC
    5257        REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_v !< discretized artificial dissipation at leftward-side of the grid box
    5258        REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local_v !< discretized 6th-order flux at leftward-side of the grid box
    5259 #endif
    5260        
    5261        REAL(wp)    ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
    5262        REAL(wp)    ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
    5263        REAL(wp)    ::  diss_t !< discretized artificial dissipation at top of the grid box
    5264        REAL(wp)    ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
    5265        REAL(wp)    ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
    5266        REAL(wp)    ::  flux_t !< discretized 6th-order flux at top of the grid box
    5267        REAL(wp)    ::  v_comp !< advection velocity along y
    5268 #ifdef _OPENACC
    5269        REAL(wp)    ::  v_comp_s !<
    5270 #endif
    5271 !
    5272 !--    Set local version of nzb_max. At non-cyclic boundaries the order of the
    5273 !--    advection need to be degraded near the boundary. Please note, in contrast
    5274 !--    to the cache-optimized routines, nzb_max_l is set constantly for the
    5275 !--    entire subdomain, in order to avoid unsymmetric loops which might be
    5276 !--    an issue for GPUs.
    5277        IF( bc_dirichlet_l  .OR.  bc_radiation_l  .OR.                          &
    5278            bc_dirichlet_r  .OR.  bc_radiation_r  .OR.                          &
    5279            bc_dirichlet_s  .OR.  bc_radiation_s  .OR.                          &
    5280            bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
    5281           nzb_max_l = nzt
    5282        ELSE
    5283           nzb_max_l = nzb_max
    5284        END IF
    5285        
     5262
     5263       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
     5264       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
     5265       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_t !< discretized artificial dissipation at top of the grid box
     5266       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
     5267       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
     5268       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_t !< discretized 6th-order flux at top of the grid box
     5269       REAL(wp), DIMENSION(nzb:nzt+1) ::  u_comp !< advection velocity along x
     5270       REAL(wp), DIMENSION(nzb:nzt+1) ::  v_comp !< advection velocity along y
     5271       REAL(wp), DIMENSION(nzb:nzt+1) ::  w_comp !< advection velocity along z
     5272
     5273       CALL cpu_log( log_point_s(69), 'advec_v_ws', 'start' )
     5274
    52865275       gu = 2.0_wp * u_gtrans
    52875276       gv = 2.0_wp * v_gtrans
    52885277
     5278       !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, gu, gv) &
     5279       !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) &
     5280       !$ACC PRIVATE(ibit9, ibit10, ibit11, ibit12, ibit13, ibit14) &
     5281       !$ACC PRIVATE(ibit15, ibit16, ibit17) &
     5282       !$ACC PRIVATE(ibit9_l, ibit10_l, ibit11_l) &
     5283       !$ACC PRIVATE(ibit12_s, ibit13_s, ibit14_s) &
     5284       !$ACC PRIVATE(flux_r, diss_r) &
     5285       !$ACC PRIVATE(flux_n, diss_n) &
     5286       !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) &
     5287       !$ACC PRIVATE(flux_l_v, diss_l_v, flux_s_v, diss_s_v) &
     5288       !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s, w_comp) &
     5289       !$ACC PRESENT(advc_flags_m) &
     5290       !$ACC PRESENT(u, v, w) &
     5291       !$ACC PRESENT(drho_air, rho_air_zw, ddzw) &
     5292       !$ACC PRESENT(tend) &
     5293       !$ACC PRESENT(hom(:,1,1:3,0)) &
     5294       !$ACC PRESENT(weight_substep(intermediate_timestep_count)) &
     5295       !$ACC PRESENT(sums_vs2_ws_l, sums_wsvs_ws_l)
     5296       DO  i = nxl, nxr
     5297          DO  j = nysv, nyn
     5298!
     5299!--          Used local modified copy of nzb_max (used to degrade order of
     5300!--          discretization) at non-cyclic boundaries. Modify only at relevant points
     5301!--          instead of the entire subdomain. This should lead to better
     5302!--          load balance between boundary and non-boundary PEs.
     5303             IF( ( bc_dirichlet_l  .OR.  bc_radiation_l )  .AND.  i <= nxl + 2  .OR. &
     5304                 ( bc_dirichlet_r  .OR.  bc_radiation_r )  .AND.  i >= nxr - 2  .OR. &
     5305                 ( bc_dirichlet_s  .OR.  bc_radiation_s )  .AND.  j <= nys + 2  .OR. &
     5306                 ( bc_dirichlet_n  .OR.  bc_radiation_n )  .AND.  j >= nyn - 2 )  THEN
     5307                nzb_max_l = nzt
     5308             ELSE
     5309                nzb_max_l = nzb_max
     5310             END IF
     5311
    52895312#ifndef _OPENACC
    5290 !
    5291 !--    First compute the whole left boundary of the processor domain
    5292        i = nxl
    5293        DO  j = nysv, nyn
    5294           DO  k = nzb+1, nzb_max_l
    5295 
    5296              ibit11 = REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp )
    5297              ibit10 = REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp )
    5298              ibit9  = REAL( IBITS(advc_flags_m(k,j,i-1),9,1),  KIND = wp )
    5299 
    5300              u_comp                   = u(k,j-1,i) + u(k,j,i) - gu
    5301              swap_flux_x_local_v(k,j) = u_comp * (                             &
     5313             IF ( i == nxl )  THEN
     5314                DO  k = nzb+1, nzb_max_l
     5315
     5316                   ibit11 = REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp )
     5317                   ibit10 = REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp )
     5318                   ibit9  = REAL( IBITS(advc_flags_m(k,j,i-1),9,1),  KIND = wp )
     5319
     5320                   u_comp(k)        = u(k,j-1,i) + u(k,j,i) - gu
     5321                   flux_l_v(k,j,tn) = u_comp(k) * (                            &
    53025322                                      ( 37.0_wp * ibit11 * adv_mom_5           &
    53035323                                   +     7.0_wp * ibit10 * adv_mom_3           &
     
    53145334                                                 )
    53155335
    5316               swap_diss_x_local_v(k,j) = - ABS( u_comp ) * (                   &
     5336                   diss_l_v(k,j,tn) = - ABS( u_comp(k) ) * (                   &
    53175337                                      ( 10.0_wp * ibit11 * adv_mom_5           &
    53185338                                   +     3.0_wp * ibit10 * adv_mom_3           &
     
    53295349                                                           )
    53305350
    5331           ENDDO
    5332 
    5333           DO  k = nzb_max_l+1, nzt
    5334 
    5335              u_comp                   = u(k,j-1,i) + u(k,j,i) - gu
    5336              swap_flux_x_local_v(k,j) = u_comp * (                             &
     5351                ENDDO
     5352
     5353                DO  k = nzb_max_l+1, nzt
     5354
     5355                   u_comp(k)        = u(k,j-1,i) + u(k,j,i) - gu
     5356                   flux_l_v(k,j,tn) = u_comp(k) * (                            &
    53375357                             37.0_wp * ( v(k,j,i) + v(k,j,i-1)   )             &
    53385358                           -  8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) )             &
    53395359                           +           ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5
    5340              swap_diss_x_local_v(k,j) = - ABS( u_comp ) * (                    &
     5360                   diss_l_v(k,j,tn) = - ABS( u_comp(k) ) * (                   &
    53415361                             10.0_wp * ( v(k,j,i) - v(k,j,i-1)   )             &
    53425362                           -  5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) )             &
    53435363                           +           ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5
    53445364
    5345           ENDDO
    5346 
    5347        ENDDO
     5365                ENDDO
     5366             ENDIF
     5367
     5368             IF ( j == nysv )  THEN
     5369                DO  k = nzb+1, nzb_max_l
     5370
     5371                   ibit14 = REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp )
     5372                   ibit13 = REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp )
     5373                   ibit12 = REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp )
     5374
     5375                   v_comp(k)      = v(k,j,i) + v(k,j-1,i) - gv
     5376                   flux_s_v(k,tn) = v_comp(k) * (                              &
     5377                                         ( 37.0_wp * ibit14 * adv_mom_5        &
     5378                                      +     7.0_wp * ibit13 * adv_mom_3        &
     5379                                      +              ibit12 * adv_mom_1        &
     5380                                         ) *                                   &
     5381                                           ( v(k,j,i)   + v(k,j-1,i) )         &
     5382                                  -      (  8.0_wp * ibit14 * adv_mom_5        &
     5383                                      +              ibit13 * adv_mom_3        &
     5384                                         ) *                                   &
     5385                                           ( v(k,j+1,i) + v(k,j-2,i) )         &
     5386                                  +      (           ibit14 * adv_mom_5        &
     5387                                         ) *                                   &
     5388                                           ( v(k,j+2,i) + v(k,j-3,i) )         &
     5389                                                )
     5390
     5391                   diss_s_v(k,tn) = - ABS( v_comp(k) ) * (                     &
     5392                                         ( 10.0_wp * ibit14 * adv_mom_5        &
     5393                                      +     3.0_wp * ibit13 * adv_mom_3        &
     5394                                      +              ibit12 * adv_mom_1        &
     5395                                         ) *                                   &
     5396                                           ( v(k,j,i)   - v(k,j-1,i) )         &
     5397                                  -      (  5.0_wp * ibit14 * adv_mom_5        &
     5398                                      +              ibit13 * adv_mom_3        &
     5399                                         ) *                                   &
     5400                                           ( v(k,j+1,i) - v(k,j-2,i) )         &
     5401                                  +      (           ibit14 * adv_mom_5        &
     5402                                         ) *                                   &
     5403                                           ( v(k,j+2,i) - v(k,j-3,i) )         &
     5404                                                         )
     5405
     5406                ENDDO
     5407
     5408                DO  k = nzb_max_l+1, nzt
     5409
     5410                   v_comp(k)      = v(k,j,i) + v(k,j-1,i) - gv
     5411                   flux_s_v(k,tn) = v_comp(k) * (                              &
     5412                                 37.0_wp * ( v(k,j,i) + v(k,j-1,i)   )         &
     5413                               -  8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) )         &
     5414                               +           ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5
     5415                   diss_s_v(k,tn) = - ABS( v_comp(k) ) * (                     &
     5416                                 10.0_wp * ( v(k,j,i) - v(k,j-1,i)   )         &
     5417                               -  5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) )         &
     5418                               +           ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5
     5419
     5420                ENDDO
     5421             ENDIF
    53485422#endif
    5349 
    5350        !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, gu, gv) &
    5351        !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) &
    5352        !$ACC PRIVATE(ibit9, ibit10, ibit11, ibit12, ibit13, ibit14) &
    5353        !$ACC PRIVATE(ibit9_l, ibit10_l, ibit11_l) &
    5354        !$ACC PRIVATE(ibit12_s, ibit13_s, ibit14_s) &
    5355        !$ACC PRIVATE(ibit15, ibit16, ibit17) &
    5356        !$ACC PRIVATE(flux_r, diss_r, flux_l, diss_l) &
    5357        !$ACC PRIVATE(flux_n, diss_n, flux_s, diss_s) &
    5358        !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) &
    5359        !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s, w_comp) &
    5360        !$ACC PRESENT(advc_flags_m) &
    5361        !$ACC PRESENT(u, v, w) &
    5362        !$ACC PRESENT(drho_air, rho_air_zw, ddzw) &
    5363        !$ACC PRESENT(tend) &
    5364        !$ACC PRESENT(hom(nzb+1:nzb_max_l,1,2:3,0)) &
    5365        !$ACC PRESENT(weight_substep(intermediate_timestep_count)) &
    5366        !$ACC PRESENT(sums_vs2_ws_l, sums_wsvs_ws_l)
    5367        DO i = nxl, nxr
    5368 
    5369 #ifndef _OPENACC
    5370           j = nysv
    5371           DO  k = nzb+1, nzb_max_l
    5372 
    5373              ibit14 = REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp )
    5374              ibit13 = REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp )
    5375              ibit12 = REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp )
    5376 
    5377              v_comp                 = v(k,j,i) + v(k,j-1,i) - gv
    5378              swap_flux_y_local_v(k) = v_comp * (                               &
    5379                                    ( 37.0_wp * ibit14 * adv_mom_5              &
    5380                                 +     7.0_wp * ibit13 * adv_mom_3              &
    5381                                 +              ibit12 * adv_mom_1              &
    5382                                    ) *                                         &
    5383                                      ( v(k,j,i)   + v(k,j-1,i) )               &
    5384                             -      (  8.0_wp * ibit14 * adv_mom_5              &
    5385                                 +              ibit13 * adv_mom_3              &
    5386                                    ) *                                         &
    5387                                      ( v(k,j+1,i) + v(k,j-2,i) )               &
    5388                             +      (           ibit14 * adv_mom_5              &
    5389                                    ) *                                         &
    5390                                      ( v(k,j+2,i) + v(k,j-3,i) )               &
    5391                                                  )
    5392 
    5393              swap_diss_y_local_v(k) = - ABS( v_comp ) * (                      &
    5394                                    ( 10.0_wp * ibit14 * adv_mom_5              &
    5395                                 +     3.0_wp * ibit13 * adv_mom_3              &
    5396                                 +              ibit12 * adv_mom_1              &
    5397                                    ) *                                         &
    5398                                      ( v(k,j,i)   - v(k,j-1,i) )               &
    5399                             -      (  5.0_wp * ibit14 * adv_mom_5              &
    5400                                 +              ibit13 * adv_mom_3              &
    5401                                    ) *                                         &
    5402                                      ( v(k,j+1,i) - v(k,j-2,i) )               &
    5403                             +      (           ibit14 * adv_mom_5              &
    5404                                    ) *                                         &
    5405                                      ( v(k,j+2,i) - v(k,j-3,i) )               &
    5406                                                           )
    5407 
    5408           ENDDO
    5409 
    5410           DO  k = nzb_max_l+1, nzt
    5411 
    5412              v_comp                 = v(k,j,i) + v(k,j-1,i) - gv
    5413              swap_flux_y_local_v(k) = v_comp * (                               &
    5414                            37.0_wp * ( v(k,j,i) + v(k,j-1,i)   )               &
    5415                          -  8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) )               &
    5416                          +           ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5
    5417              swap_diss_y_local_v(k) = - ABS( v_comp ) * (                      &
    5418                            10.0_wp * ( v(k,j,i) - v(k,j-1,i)   )               &
    5419                          -  5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) )               &
    5420                          +           ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5
    5421 
    5422           ENDDO
    5423 #endif
    5424 
    5425           DO  j = nysv, nyn
    5426 
    5427              flux_d    = 0.0_wp
    5428              diss_d    = 0.0_wp
    54295423
    54305424             DO  k = nzb+1, nzb_max_l
     
    54345428                ibit9  = REAL( IBITS(advc_flags_m(k,j,i),9,1),  KIND = wp )
    54355429
    5436                 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu
    5437                 flux_r = u_comp * (                                            &
     5430                u_comp(k) = u(k,j-1,i+1) + u(k,j,i+1) - gu
     5431                flux_r(k) = u_comp(k) * (                                      &
    54385432                          ( 37.0_wp * ibit11 * adv_mom_5                       &
    54395433                       +     7.0_wp * ibit10 * adv_mom_3                       &
     
    54485442                          ) *                                                  &
    54495443                                 ( v(k,j,i+3) + v(k,j,i-2) )                   &
    5450                                      )
    5451 
    5452                 diss_r = - ABS( u_comp ) * (                                   &
     5444                                        )
     5445
     5446                diss_r(k) = - ABS( u_comp(k) ) * (                             &
    54535447                          ( 10.0_wp * ibit11 * adv_mom_5                       &
    54545448                       +     3.0_wp * ibit10 * adv_mom_3                       &
     
    54635457                          ) *                                                  &
    54645458                                 ( v(k,j,i+3) - v(k,j,i-2) )                   &
    5465                                               )
     5459                                                 )
    54665460
    54675461#ifdef _OPENACC
     
    54725466                ibit9_l  = REAL( IBITS(advc_flags_m(k,j,i-1),9,1),  KIND = wp )
    54735467
    5474                 u_comp_l  = u(k,j-1,i) + u(k,j,i) - gu
    5475                 flux_l    = u_comp_l * (                                       &
     5468                u_comp_l            = u(k,j-1,i) + u(k,j,i) - gu
     5469                flux_l_v(k,j,tn)    = u_comp_l * (                             &
    54765470                                      ( 37.0_wp * ibit11_l * adv_mom_5         &
    54775471                                   +     7.0_wp * ibit10_l * adv_mom_3         &
     
    54885482                                                 )
    54895483
    5490                  diss_l   = - ABS( u_comp_l ) * (                              &
     5484                 diss_l_v(k,j,tn)   = - ABS( u_comp_l ) * (                    &
    54915485                                      ( 10.0_wp * ibit11_l * adv_mom_5         &
    54925486                                   +     3.0_wp * ibit10_l * adv_mom_3         &
     
    55025496                                     ( v(k,j,i+2) - v(k,j,i-3) )               &
    55035497                                                           )
    5504 #else
    5505                 flux_l = swap_flux_x_local_v(k,j)
    5506                 diss_l = swap_diss_x_local_v(k,j)
    55075498#endif
    55085499
     
    55115502                ibit12 = REAL( IBITS(advc_flags_m(k,j,i),12,1), KIND = wp )
    55125503
    5513                 v_comp = v(k,j+1,i) + v(k,j,i)
    5514                 flux_n = ( v_comp - gv ) * (                                   &
     5504                v_comp(k) = v(k,j+1,i) + v(k,j,i)
     5505                flux_n(k) = ( v_comp(k) - gv ) * (                             &
    55155506                          ( 37.0_wp * ibit14 * adv_mom_5                       &
    55165507                       +     7.0_wp * ibit13 * adv_mom_3                       &
     
    55275518                                     )
    55285519
    5529                 diss_n = - ABS( v_comp - gv ) * (                              &
     5520                diss_n(k) = - ABS( v_comp(k) - gv ) * (                        &
    55305521                          ( 10.0_wp * ibit14 * adv_mom_5                       &
    55315522                       +     3.0_wp * ibit13 * adv_mom_3                       &
     
    55495540                ibit12_s = REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp )
    55505541
    5551                 v_comp_s = v(k,j,i) + v(k,j-1,i) - gv
    5552                 flux_s   = v_comp_s * (                                        &
     5542                v_comp_s         = v(k,j,i) + v(k,j-1,i) - gv
     5543                flux_s_v(k,tn)   = v_comp_s * (                                &
    55535544                                   ( 37.0_wp * ibit14_s * adv_mom_5            &
    55545545                                +     7.0_wp * ibit13_s * adv_mom_3            &
     
    55635554                                   ) *                                         &
    55645555                                     ( v(k,j+2,i) + v(k,j-3,i) )               &
    5565                                                  )
    5566 
    5567                 diss_s   = - ABS( v_comp_s ) * (                               &
     5556                                               )
     5557
     5558               diss_s_v(k,tn)   = - ABS( v_comp_s ) * (                        &
    55685559                                   ( 10.0_wp * ibit14_s * adv_mom_5            &
    55695560                                +     3.0_wp * ibit13_s * adv_mom_3            &
     
    55785569                                   ) *                                         &
    55795570                                     ( v(k,j+2,i) - v(k,j-3,i) )               &
    5580                                                           )
    5581 #else
    5582                flux_s = swap_flux_y_local_v(k)
    5583                diss_s = swap_diss_y_local_v(k)
     5571                                                      )
    55845572#endif
    5585 
     5573             ENDDO
     5574
     5575             DO  k = nzb_max_l+1, nzt
     5576
     5577                u_comp(k) = u(k,j-1,i+1) + u(k,j,i+1) - gu
     5578                flux_r(k) = u_comp(k) * (                                      &
     5579                      37.0_wp * ( v(k,j,i+1) + v(k,j,i)   )                    &
     5580                    -  8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) )                    &
     5581                    +           ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_5
     5582
     5583                diss_r(k) = - ABS( u_comp(k) ) * (                             &
     5584                      10.0_wp * ( v(k,j,i+1) - v(k,j,i) )                      &
     5585                    -  5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) )                    &
     5586                    +           ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_5
     5587
     5588#ifdef _OPENACC
     5589!
     5590!--             Recompute the left fluxes.
     5591                u_comp_l           = u(k,j-1,i) + u(k,j,i) - gu
     5592                flux_l_v(k,j,tn)   = u_comp_l * (                              &
     5593                             37.0_wp * ( v(k,j,i) + v(k,j,i-1)   )             &
     5594                           -  8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) )             &
     5595                           +           ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5
     5596                diss_l_v(k,j,tn)   = - ABS( u_comp_l ) * (                     &
     5597                             10.0_wp * ( v(k,j,i) - v(k,j,i-1)   )             &
     5598                           -  5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) )             &
     5599                           +           ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5
     5600#endif
     5601
     5602                v_comp(k) = v(k,j+1,i) + v(k,j,i)
     5603                flux_n(k) = ( v_comp(k) - gv ) * (                             &
     5604                      37.0_wp * ( v(k,j+1,i) + v(k,j,i)   )                    &
     5605                    -  8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) )                    &
     5606                      +         ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_5
     5607
     5608                diss_n(k) = - ABS( v_comp(k) - gv ) * (                        &
     5609                      10.0_wp * ( v(k,j+1,i) - v(k,j,i)   )                    &
     5610                    -  5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) )                    &
     5611                    +           ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_5
     5612
     5613#ifdef _OPENACC
     5614!
     5615!--             Recompute the south fluxes.
     5616                v_comp_s = v(k,j,i) + v(k,j-1,i) - gv
     5617                flux_s_v(k,tn)   = v_comp_s * (                                &
     5618                           37.0_wp * ( v(k,j,i) + v(k,j-1,i)   )               &
     5619                         -  8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) )               &
     5620                         +           ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5
     5621                diss_s_v(k,tn)   = - ABS( v_comp_s ) * (                       &
     5622                           10.0_wp * ( v(k,j,i) - v(k,j-1,i)   )               &
     5623                         -  5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) )               &
     5624                         +           ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5
     5625#endif
     5626             ENDDO
     5627!
     5628!--          Now, compute vertical fluxes. Split loop into a part treating the
     5629!--          lowest 2 grid points with indirect indexing, a main loop without
     5630!--          indirect indexing, and a loop for the uppermost 2 grip points with
     5631!--          indirect indexing. This allows better vectorization for the main loop.
     5632!--          First, compute the flux at model surface, which need has to be
     5633!--          calculated explicetely for the tendency at
     5634!--          the first w-level. For topography wall this is done implicitely by
     5635!--          advc_flags_m.
     5636             flux_t(nzb) = 0.0_wp
     5637             diss_t(nzb) = 0.0_wp
     5638             w_comp(nzb) = 0.0_wp
     5639             DO  k = nzb+1, nzb+2
    55865640!
    55875641!--             k index has to be modified near bottom and top, else array
     
    55955649                k_mm  = k - 2 * ibit17
    55965650
    5597                 w_comp = w(k,j-1,i) + w(k,j,i)
    5598                 flux_t = w_comp * rho_air_zw(k) * (                            &
     5651                w_comp(k) = w(k,j-1,i) + w(k,j,i)
     5652                flux_t(k) = w_comp(k) * rho_air_zw(k) * (                      &
    55995653                          ( 37.0_wp * ibit17 * adv_mom_5                       &
    56005654                       +     7.0_wp * ibit16 * adv_mom_3                       &
     
    56095663                          ) *                                                  &
    56105664                             ( v(k_ppp,j,i) + v(k_mm,j,i) )                    &
    5611                                       )
    5612 
    5613                 diss_t = - ABS( w_comp ) * rho_air_zw(k) * (                   &
     5665                                                        )
     5666
     5667                diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (             &
    56145668                          ( 10.0_wp * ibit17 * adv_mom_5                       &
    56155669                       +     3.0_wp * ibit16 * adv_mom_3                       &
     
    56245678                          ) *                                                  &
    56255679                             ( v(k_ppp,j,i) - v(k_mm,j,i) )                    &
    5626                                                )
    5627 !
    5628 !--             Calculate the divergence of the velocity field. A respective
    5629 !--             correction is needed to overcome numerical instabilities caused
    5630 !--             by a not sufficient reduction of divergences near topography.
    5631                 div = ( ( ( u_comp     + gu )                                  &
    5632                                        * ( ibit9 + ibit10 + ibit11 )           &
    5633                 - ( u(k,j-1,i)   + u(k,j,i) )                                  &
    5634                                        * (                                     &
    5635                         REAL( IBITS(advc_flags_m(k,j,i-1),9,1), KIND = wp )    &
    5636                       + REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp )   &
    5637                       + REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp )   &
    5638                                          )                                     &
    5639                   ) * ddx                                                      &
    5640                +  ( v_comp                                                     &
    5641                                        * ( ibit12 + ibit13 + ibit14 )          &
    5642                 - ( v(k,j,i)     + v(k,j-1,i) )                                &
    5643                                        * (                                     &
    5644                         REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp )   &
    5645                       + REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp )   &
    5646                       + REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp )   &
    5647                                          )                                     &
    5648                   ) * ddy                                                      &
    5649                +  ( w_comp * rho_air_zw(k)                                     &
    5650                                        * ( ibit15 + ibit16 + ibit17 )          &
    5651                 - ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1)              &
    5652                                        * (                                     &
    5653                         REAL( IBITS(advc_flags_m(k-1,j,i),15,1), KIND = wp )   &
    5654                       + REAL( IBITS(advc_flags_m(k-1,j,i),16,1), KIND = wp )   &
    5655                       + REAL( IBITS(advc_flags_m(k-1,j,i),17,1), KIND = wp )   &
    5656                                          )                                     &
    5657                    ) * drho_air(k) * ddzw(k)                                   &
    5658                 ) * 0.5_wp
    5659 
    5660 
    5661                 tend(k,j,i) = tend(k,j,i) - (                                  &
    5662                        ( ( flux_r + diss_r )                                   &
    5663                      -   ( flux_l + diss_l ) ) * ddx                           &
    5664                      + ( ( flux_n + diss_n )                                   &
    5665                      -   ( flux_s + diss_s ) ) * ddy                           &
    5666                      + ( ( flux_t + diss_t )                                   &
    5667                      -   ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k)         &
    5668                                             )  + v(k,j,i) * div
    5669 
    5670 #ifndef _OPENACC
    5671                 swap_flux_x_local_v(k,j) = flux_r
    5672                 swap_diss_x_local_v(k,j) = diss_r
    5673                 swap_flux_y_local_v(k)   = flux_n
    5674                 swap_diss_y_local_v(k)   = diss_n
    5675 #endif
    5676                 flux_d                   = flux_t
    5677                 diss_d                   = diss_t
    5678 
    5679 !
    5680 !--             Statistical Evaluation of v'v'. The factor has to be applied
    5681 !--             for right evaluation when gallilei_trans = .T. .
    5682                 !$ACC ATOMIC
    5683                 sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                      &
    5684                 + ( flux_n                                                     &
    5685                     * ( v_comp - 2.0_wp * hom(k,1,2,0)                   )     &
    5686                     / ( v_comp - gv + SIGN( 1.0E-20_wp, v_comp - gv )    )     &
    5687                +   diss_n                                                      &
    5688                     *   ABS( v_comp - 2.0_wp * hom(k,1,2,0)              )     &
    5689                     / ( ABS( v_comp - gv ) + 1.0E-20_wp                  )     &
    5690                   ) *   weight_substep(intermediate_timestep_count)
    5691 !
    5692 !--             Statistical Evaluation of w'u'.
    5693                 !$ACC ATOMIC
    5694                 sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                    &
    5695                 + ( flux_t                                                     &
    5696                     * ( w_comp - 2.0_wp * hom(k,1,3,0)                   )     &
    5697                     / ( w_comp + SIGN( 1.0E-20_wp, w_comp )              )     &
    5698                +   diss_t                                                      &
    5699                     *   ABS( w_comp - 2.0_wp * hom(k,1,3,0)              )     &
    5700                     / ( ABS( w_comp ) + 1.0E-20_wp                       )     &
    5701                   ) *   weight_substep(intermediate_timestep_count)
    5702 
     5680                                                                 )
    57035681             ENDDO
    57045682
    5705              DO  k = nzb_max_l+1, nzt
    5706 
    5707                 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu
    5708                 flux_r = u_comp * (                                            &
    5709                       37.0_wp * ( v(k,j,i+1) + v(k,j,i)   )                    &
    5710                     -  8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) )                    &
    5711                     +           ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_5
    5712 
    5713                 diss_r = - ABS( u_comp ) * (                                   &
    5714                       10.0_wp * ( v(k,j,i+1) - v(k,j,i) )                      &
    5715                     -  5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) )                    &
    5716                     +           ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_5
    5717 
    5718 #ifdef _OPENACC
    5719 !
    5720 !--             Recompute the left fluxes.
    5721                 u_comp_l = u(k,j-1,i) + u(k,j,i) - gu
    5722                 flux_l   = u_comp_l * (                                        &
    5723                              37.0_wp * ( v(k,j,i) + v(k,j,i-1)   )             &
    5724                            -  8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) )             &
    5725                            +           ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5
    5726                 diss_l   = - ABS( u_comp_l ) * (                               &
    5727                              10.0_wp * ( v(k,j,i) - v(k,j,i-1)   )             &
    5728                            -  5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) )             &
    5729                            +           ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5
    5730 #else
    5731                 flux_l = swap_flux_x_local_v(k,j)
    5732                 diss_l = swap_diss_x_local_v(k,j)
    5733 #endif
    5734 
    5735                 v_comp = v(k,j+1,i) + v(k,j,i)
    5736                 flux_n = ( v_comp - gv ) * (                                   &
    5737                       37.0_wp * ( v(k,j+1,i) + v(k,j,i)   )                    &
    5738                     -  8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) )                    &
    5739                       +         ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_5
    5740 
    5741                 diss_n = - ABS( v_comp - gv ) * (                              &
    5742                       10.0_wp * ( v(k,j+1,i) - v(k,j,i)   )                    &
    5743                     -  5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) )                    &
    5744                     +           ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_5
    5745 
    5746 #ifdef _OPENACC
    5747 !
    5748 !--             Recompute the south fluxes.
    5749                 v_comp_s = v(k,j,i) + v(k,j-1,i) - gv
    5750                 flux_s   = v_comp_s * (                                        &
    5751                            37.0_wp * ( v(k,j,i) + v(k,j-1,i)   )               &
    5752                          -  8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) )               &
    5753                          +           ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5
    5754                 diss_s   = - ABS( v_comp_s ) * (                               &
    5755                            10.0_wp * ( v(k,j,i) - v(k,j-1,i)   )               &
    5756                          -  5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) )               &
    5757                          +           ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5
    5758 #else
    5759                 flux_s = swap_flux_y_local_v(k)
    5760                 diss_s = swap_diss_y_local_v(k)
    5761 #endif
    5762 
     5683             DO  k = nzb+3, nzt-2
     5684                ibit17 = REAL( IBITS(advc_flags_m(k,j,i),17,1), KIND = wp )
     5685                ibit16 = REAL( IBITS(advc_flags_m(k,j,i),16,1), KIND = wp )
     5686                ibit15 = REAL( IBITS(advc_flags_m(k,j,i),15,1), KIND = wp )
     5687
     5688                w_comp(k) = w(k,j-1,i) + w(k,j,i)
     5689                flux_t(k) = w_comp(k) * rho_air_zw(k) * (                      &
     5690                          ( 37.0_wp * ibit17 * adv_mom_5                       &
     5691                       +     7.0_wp * ibit16 * adv_mom_3                       &
     5692                       +              ibit15 * adv_mom_1                       &
     5693                          ) *                                                  &
     5694                             ( v(k+1,j,i)  + v(k,j,i)    )                     &
     5695                   -      (  8.0_wp * ibit17 * adv_mom_5                       &
     5696                       +              ibit16 * adv_mom_3                       &
     5697                          ) *                                                  &
     5698                             ( v(k+2,j,i) + v(k-1,j,i)   )                     &
     5699                   +      (           ibit17 * adv_mom_5                       &
     5700                          ) *                                                  &
     5701                             ( v(k+3,j,i) + v(k-2,j,i)   )                     &
     5702                                                        )
     5703
     5704                diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (             &
     5705                          ( 10.0_wp * ibit17 * adv_mom_5                       &
     5706                       +     3.0_wp * ibit16 * adv_mom_3                       &
     5707                       +              ibit15 * adv_mom_1                       &
     5708                          ) *                                                  &
     5709                             ( v(k+1,j,i) - v(k,j,i)     )                     &
     5710                   -      (  5.0_wp * ibit17 * adv_mom_5                       &
     5711                       +              ibit16 * adv_mom_3                       &
     5712                          ) *                                                  &
     5713                             ( v(k+2,j,i) - v(k-1,j,i)   )                     &
     5714                   +      (           ibit17 * adv_mom_5                       &
     5715                          ) *                                                  &
     5716                             ( v(k+3,j,i) - v(k-2,j,i)   )                     &
     5717                                                                 )
     5718             ENDDO
     5719
     5720             DO  k = nzt-1, nzt-symmetry_flag
    57635721!
    57645722!--             k index has to be modified near bottom and top, else array
     
    57725730                k_mm  = k - 2 * ibit17
    57735731
    5774                 w_comp = w(k,j-1,i) + w(k,j,i)
    5775                 flux_t = w_comp * rho_air_zw(k) * (                            &
     5732                w_comp(k) = w(k,j-1,i) + w(k,j,i)
     5733                flux_t(k) = w_comp(k) * rho_air_zw(k) * (                      &
    57765734                          ( 37.0_wp * ibit17 * adv_mom_5                       &
    57775735                       +     7.0_wp * ibit16 * adv_mom_3                       &
     
    57865744                          ) *                                                  &
    57875745                             ( v(k_ppp,j,i) + v(k_mm,j,i) )                    &
    5788                                       )
    5789 
    5790                 diss_t = - ABS( w_comp ) * rho_air_zw(k) * (                   &
     5746                                                        )
     5747
     5748                diss_t(k) = - ABS( w_comp(k) ) * rho_air_zw(k) * (             &
    57915749                          ( 10.0_wp * ibit17 * adv_mom_5                       &
    57925750                       +     3.0_wp * ibit16 * adv_mom_3                       &
     
    58015759                          ) *                                                  &
    58025760                             ( v(k_ppp,j,i) - v(k_mm,j,i) )                    &
    5803                                                )
     5761                                                                 )
     5762             ENDDO
     5763
     5764!
     5765!--          Set resolved/turbulent flux at model top to zero (w-level). In case that
     5766!--          a symmetric behavior between bottom and top shall be guaranteed (closed
     5767!--          channel flow), the flux at nzt is also set to zero.
     5768             IF ( symmetry_flag == 1 ) THEN
     5769                flux_t(nzt) = 0.0_wp
     5770                diss_t(nzt) = 0.0_wp
     5771                w_comp(nzt) = 0.0_wp
     5772             ENDIF
     5773             flux_t(nzt+1) = 0.0_wp
     5774             diss_t(nzt+1) = 0.0_wp
     5775             w_comp(nzt+1) = 0.0_wp
     5776
     5777             DO k = nzb+1, nzb_max_l
     5778
     5779                flux_d    = flux_t(k-1)
     5780                diss_d    = diss_t(k-1)
     5781
     5782                ibit11 = REAL( IBITS(advc_flags_m(k,j,i),11,1), KIND = wp )
     5783                ibit10 = REAL( IBITS(advc_flags_m(k,j,i),10,1), KIND = wp )
     5784                ibit9  = REAL( IBITS(advc_flags_m(k,j,i),9,1),  KIND = wp )
     5785
     5786                ibit14 = REAL( IBITS(advc_flags_m(k,j,i),14,1), KIND = wp )
     5787                ibit13 = REAL( IBITS(advc_flags_m(k,j,i),13,1), KIND = wp )
     5788                ibit12 = REAL( IBITS(advc_flags_m(k,j,i),12,1), KIND = wp )
     5789
     5790                ibit17 = REAL( IBITS(advc_flags_m(k,j,i),17,1), KIND = wp )
     5791                ibit16 = REAL( IBITS(advc_flags_m(k,j,i),16,1), KIND = wp )
     5792                ibit15 = REAL( IBITS(advc_flags_m(k,j,i),15,1), KIND = wp )
    58045793!
    58055794!--             Calculate the divergence of the velocity field. A respective
    58065795!--             correction is needed to overcome numerical instabilities caused
    58075796!--             by a not sufficient reduction of divergences near topography.
    5808                 div = ( ( u_comp + gu - ( u(k,j-1,i)   + u(k,j,i)   ) ) * ddx  &
    5809                      +  ( v_comp      - ( v(k,j,i)     + v(k,j-1,i) ) ) * ddy  &
    5810                      +  (   w_comp                      * rho_air_zw(k) -      &
    5811                           ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1)      &
    5812                         ) * drho_air(k) * ddzw(k)                              &
    5813                       ) * 0.5_wp
    5814  
     5797                div = ( ( ( u_comp(k)     + gu )                               &
     5798                                       * ( ibit9 + ibit10 + ibit11 )           &
     5799                - ( u(k,j-1,i)   + u(k,j,i) )                                  &
     5800                                       * (                                     &
     5801                        REAL( IBITS(advc_flags_m(k,j,i-1),9,1), KIND = wp )    &
     5802                      + REAL( IBITS(advc_flags_m(k,j,i-1),10,1), KIND = wp )   &
     5803                      + REAL( IBITS(advc_flags_m(k,j,i-1),11,1), KIND = wp )   &
     5804                                         )                                     &
     5805                  ) * ddx                                                      &
     5806               +  ( v_comp(k)                                                  &
     5807                                       * ( ibit12 + ibit13 + ibit14 )          &
     5808                - ( v(k,j,i)     + v(k,j-1,i) )                                &
     5809                                       * (                                     &
     5810                        REAL( IBITS(advc_flags_m(k,j-1,i),12,1), KIND = wp )   &
     5811                      + REAL( IBITS(advc_flags_m(k,j-1,i),13,1), KIND = wp )   &
     5812                      + REAL( IBITS(advc_flags_m(k,j-1,i),14,1), KIND = wp )   &
     5813                                         )                                     &
     5814                  ) * ddy                                                      &
     5815               +  ( w_comp(k) * rho_air_zw(k)                                  &
     5816                                       * ( ibit15 + ibit16 + ibit17 )          &
     5817                - ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1)              &
     5818                                       * (                                     &
     5819                        REAL( IBITS(advc_flags_m(k-1,j,i),15,1), KIND = wp )   &
     5820                      + REAL( IBITS(advc_flags_m(k-1,j,i),16,1), KIND = wp )   &
     5821                      + REAL( IBITS(advc_flags_m(k-1,j,i),17,1), KIND = wp )   &
     5822                                         )                                     &
     5823                   ) * drho_air(k) * ddzw(k)                                   &
     5824                ) * 0.5_wp
     5825
     5826
    58155827                tend(k,j,i) = tend(k,j,i) - (                                  &
    5816                        ( ( flux_r + diss_r )                                   &
    5817                      -   ( flux_l + diss_l ) ) * ddx                           &
    5818                      + ( ( flux_n + diss_n )                                   &
    5819                      -   ( flux_s + diss_s ) ) * ddy                           &
    5820                      + ( ( flux_t + diss_t )                                   &
     5828                       ( ( flux_r(k) + diss_r(k) )                             &
     5829                     -   ( flux_l_v(k,j,tn) + diss_l_v(k,j,tn) ) ) * ddx       &
     5830                     + ( ( flux_n(k) + diss_n(k) )                             &
     5831                     -   ( flux_s_v(k,tn) + diss_s_v(k,tn) ) ) * ddy           &
     5832                     + ( ( flux_t(k) + diss_t(k) )                             &
    58215833                     -   ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k)         &
    58225834                                            )  + v(k,j,i) * div
    58235835
    58245836#ifndef _OPENACC
    5825                 swap_flux_x_local_v(k,j) = flux_r
    5826                 swap_diss_x_local_v(k,j) = diss_r
    5827                 swap_flux_y_local_v(k)   = flux_n
    5828                 swap_diss_y_local_v(k)   = diss_n
     5837!
     5838!--             Swap fluxes. Note, in the OPENACC case these are computed again.
     5839                flux_l_v(k,j,tn) = flux_r(k)
     5840                diss_l_v(k,j,tn) = diss_r(k)
     5841                flux_s_v(k,tn)   = flux_n(k)
     5842                diss_s_v(k,tn)   = diss_n(k)
    58295843#endif
    5830                 flux_d                   = flux_t
    5831                 diss_d                   = diss_t
    58325844
    58335845!
     
    58365848                !$ACC ATOMIC
    58375849                sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                      &
    5838                 + ( flux_n                                                     &
    5839                     * ( v_comp - 2.0_wp * hom(k,1,2,0)                   )     &
    5840                     / ( v_comp - gv + SIGN( 1.0E-20_wp, v_comp - gv )    )     &
    5841                +   diss_n                                                      &
    5842                     *   ABS( v_comp - 2.0_wp * hom(k,1,2,0)              )     &
    5843                     / ( ABS( v_comp - gv ) + 1.0E-20_wp                  )     &
     5850                + ( flux_n(k)                                                  &
     5851                    * ( v_comp(k) - 2.0_wp * hom(k,1,2,0)                   )  &
     5852                    / ( v_comp(k) - gv + SIGN( 1.0E-20_wp, v_comp(k) - gv ) )  &
     5853               +   diss_n(k)                                                   &
     5854                    *   ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0)              )  &
     5855                    / ( ABS( v_comp(k) - gv ) + 1.0E-20_wp                  )  &
    58445856                  ) *   weight_substep(intermediate_timestep_count)
    58455857!
     
    58475859                !$ACC ATOMIC
    58485860                sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                    &
    5849                 + ( flux_t                                                     &
    5850                     * ( w_comp - 2.0_wp * hom(k,1,3,0)                   )     &
    5851                     / ( w_comp + SIGN( 1.0E-20_wp, w_comp )              )     &
    5852                +   diss_t                                                      &
    5853                     *   ABS( w_comp - 2.0_wp * hom(k,1,3,0)              )     &
    5854                     / ( ABS( w_comp ) + 1.0E-20_wp                       )     &
     5861                + ( flux_t(k)                                                  &
     5862                    * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                   )  &
     5863                    / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )           )  &
     5864               +   diss_t(k)                                                   &
     5865                    *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)              )  &
     5866                    / ( ABS( w_comp(k) ) + 1.0E-20_wp                       )  &
    58555867                  ) *   weight_substep(intermediate_timestep_count)
    58565868
    58575869             ENDDO
     5870
     5871             DO  k = nzb_max_l+1, nzt
     5872
     5873                flux_d    = flux_t(k-1)
     5874                diss_d    = diss_t(k-1)
     5875!
     5876!--             Calculate the divergence of the velocity field. A respective
     5877!--             correction is needed to overcome numerical instabilities caused
     5878!--             by a not sufficient reduction of divergences near topography.
     5879                div = ( ( u_comp(k) + gu - ( u(k,j-1,i)  + u(k,j,i)   ) ) * ddx&
     5880                     +  ( v_comp(k)      - ( v(k,j,i)    + v(k,j-1,i) ) ) * ddy&
     5881                     +  ( w_comp(k)                     * rho_air_zw(k) -      &
     5882                          ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1)      &
     5883                        ) * drho_air(k) * ddzw(k)                              &
     5884                      ) * 0.5_wp
     5885
     5886                tend(k,j,i) = tend(k,j,i) - (                                  &
     5887                       ( ( flux_r(k) + diss_r(k) )                             &
     5888                     -   ( flux_l_v(k,j,tn) + diss_l_v(k,j,tn) ) ) * ddx       &
     5889                     + ( ( flux_n(k) + diss_n(k) )                             &
     5890                     -   ( flux_s_v(k,tn) + diss_s_v(k,tn) ) ) * ddy           &
     5891                     + ( ( flux_t(k) + diss_t(k) )                             &
     5892                     -   ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k)         &
     5893                                            )  + v(k,j,i) * div
     5894
     5895#ifndef _OPENACC
     5896!
     5897!--             Swap fluxes. Note, in the OPENACC case these are computed again.
     5898                flux_l_v(k,j,tn) = flux_r(k)
     5899                diss_l_v(k,j,tn) = diss_r(k)
     5900                flux_s_v(k,tn)   = flux_n(k)
     5901                diss_s_v(k,tn)   = diss_n(k)
     5902#endif
     5903
     5904!
     5905!--             Statistical Evaluation of v'v'. The factor has to be applied
     5906!--             for right evaluation when gallilei_trans = .T. .
     5907                !$ACC ATOMIC
     5908                sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                      &
     5909                + ( flux_n(k)                                                  &
     5910                    * ( v_comp(k) - 2.0_wp * hom(k,1,2,0)                   )  &
     5911                    / ( v_comp(k) - gv + SIGN( 1.0E-20_wp, v_comp(k) - gv ) )  &
     5912               +   diss_n(k)                                                   &
     5913                    *   ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0)              )  &
     5914                    / ( ABS( v_comp(k) - gv ) + 1.0E-20_wp                  )  &
     5915                  ) *   weight_substep(intermediate_timestep_count)
     5916!
     5917!--             Statistical Evaluation of w'u'.
     5918                !$ACC ATOMIC
     5919                sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                    &
     5920                + ( flux_t(k)                                                  &
     5921                    * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)                   )  &
     5922                    / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )           )  &
     5923               +   diss_t(k)                                                   &
     5924                    *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)              )  &
     5925                    / ( ABS( w_comp(k) ) + 1.0E-20_wp                       )  &
     5926                  ) *   weight_substep(intermediate_timestep_count)
     5927
     5928             ENDDO
     5929
    58585930          ENDDO
    58595931       ENDDO
    58605932
     5933       CALL cpu_log( log_point_s(69), 'advec_v_ws', 'stop' )
     5934
    58615935    END SUBROUTINE advec_v_ws
    5862    
    5863    
     5936
     5937
    58645938!------------------------------------------------------------------------------!
    58655939! Description:
     
    58765950       INTEGER(iwp) ::  k_pp      !< k+2 index in disretization, can be modified to avoid segmentation faults
    58775951       INTEGER(iwp) ::  k_ppp     !< k+3 index in disretization, can be modified to avoid segmentation faults
    5878        INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms 
     5952       INTEGER(iwp) ::  nzb_max_l !< index indicating upper bound for order degradation of horizontal advection terms
    58795953       INTEGER(iwp) ::  tn = 0    !< number of OpenMP thread
    5880        
     5954
    58815955       REAL(wp)    ::  ibit18 !< flag indicating 1st-order scheme along x-direction
    58825956       REAL(wp)    ::  ibit19 !< flag indicating 3rd-order scheme along x-direction
     
    58955969       REAL(wp)    ::  ibit23_s !< flag indicating 5th-order scheme along y-direction
    58965970#endif
    5897        REAL(wp)    ::  ibit24 !< flag indicating 1st-order scheme along z-direction
    5898        REAL(wp)    ::  ibit25 !< flag indicating 3rd-order scheme along z-direction
    5899        REAL(wp)    ::  ibit26 !< flag indicating 5th-order scheme along z-direction
    5900        REAL(wp)    ::  diss_d !< artificial dissipation term at grid box bottom
    5901        REAL(wp)    ::  div    !< divergence on w-grid
    5902        REAL(wp)    ::  flux_d !< 6th-order flux at grid box bottom
    5903        REAL(wp)    ::  gu     !< Galilei-transformation velocity along x
    5904        REAL(wp)    ::  gv     !< Galilei-transformation velocity along y
    5905        REAL(wp)    ::  u_comp !< advection velocity along x
     5971       REAL(wp)    ::  ibit24   !< flag indicating 1st-order scheme along z-direction
     5972       REAL(wp)    ::  ibit25   !< flag indicating 3rd-order scheme along z-direction
     5973       REAL(wp)    ::  ibit26   !< flag indicating 5th-order scheme along z-direction
     5974       REAL(wp)    ::  diss_d   !< artificial dissipation term at grid box bottom
     5975       REAL(wp)    ::  div      !< divergence on w-grid
     5976       REAL(wp)    ::  flux_d   !< 6th-order flux at grid box bottom
     5977       REAL(wp)    ::  gu       !< Galilei-transformation velocity along x
     5978       REAL(wp)    ::  gv       !< Galilei-transformation velocity along y
    59065979#ifdef _OPENACC
    59075980       REAL(wp)    ::  u_comp_l !< advection velocity along x
    5908 #endif
    5909        REAL(wp)    ::  v_comp !< advection velocity along y
    5910 #ifdef _OPENACC
    59115981       REAL(wp)    ::  v_comp_s !< advection velocity along y
    59125982#endif
    5913        REAL(wp)    ::  w_comp !< advection velocity along z
    5914        
    5915        REAL(wp)    ::  diss_t !< discretized artificial dissipation at top of the grid box
    5916        REAL(wp)    ::  flux_t !< discretized 6th-order flux at top of the grid box
    5917        
    5918        REAL(wp)    ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
    5919        REAL(wp)    ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
    5920        REAL(wp)    ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
    5921        REAL(wp)    ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
    5922 
    5923        REAL(wp)    ::  diss_s !< discretized artificial dissipation at southward-side of the grid box
    5924        REAL(wp)    ::  flux_s !< discretized 6th-order flux at southward-side of the grid box
    5925 #ifndef _OPENACC
    5926        REAL(wp), DIMENSION(nzb+1:nzt)  ::  swap_diss_y_local_w !< discretized artificial dissipation at southward-side of the grid box
    5927        REAL(wp), DIMENSION(nzb+1:nzt)  ::  swap_flux_y_local_w !< discretized 6th-order flux at southward-side of the grid box
    5928 #endif
    5929        
    5930        REAL(wp)    ::  diss_l !< discretized artificial dissipation at leftward-side of the grid box
    5931        REAL(wp)    ::  flux_l !< discretized 6th-order flux at leftward-side of the grid box
    5932 #ifndef _OPENACC
    5933        REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_w !< discretized artificial dissipation at leftward-side of the grid box
    5934        REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local_w !< discretized 6th-order flux at leftward-side of the grid box
    5935 #endif
    5936 !
    5937 !--    Set local version of nzb_max. At non-cyclic boundaries the order of the
    5938 !--    advection need to be degraded near the boundary. Please note, in contrast
    5939 !--    to the cache-optimized routines, nzb_max_l is set constantly for the
    5940 !--    entire subdomain, in order to avoid unsymmetric loops which might be
    5941 !--    an issue for GPUs.
    5942        IF( bc_dirichlet_l  .OR.  bc_radiation_l  .OR.                          &
    5943            bc_dirichlet_r  .OR.  bc_radiation_r  .OR.                          &
    5944            bc_dirichlet_s  .OR.  bc_radiation_s  .OR.                          &
    5945            bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
    5946           nzb_max_l = nzt
    5947        ELSE
    5948           nzb_max_l = nzb_max
    5949        END IF
    5950        
     5983
     5984       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
     5985       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
     5986       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_t !< discretized artificial dissipation at top of the grid box
     5987       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
     5988       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
     5989       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_t !< discretized 6th-order flux at top of the grid box
     5990       REAL(wp), DIMENSION(nzb:nzt+1) ::  u_comp !< advection velocity along x
     5991       REAL(wp), DIMENSION(nzb:nzt+1) ::  v_comp !< advection velocity along y
     5992       REAL(wp), DIMENSION(nzb:nzt+1) ::  w_comp !< advection velocity along z
     5993
     5994
     5995       CALL cpu_log( log_point_s(87), 'advec_w_ws', 'start' )
     5996
    59515997       gu = 2.0_wp * u_gtrans
    59525998       gv = 2.0_wp * v_gtrans
    59535999
     6000       !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, gu, gv) &
     6001       !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) &
     6002       !$ACC PRIVATE(ibit18, ibit19, ibit20, ibit21, ibit22, ibit23) &
     6003       !$ACC PRIVATE(ibit24, ibit25, ibit26) &
     6004       !$ACC PRIVATE(ibit18_l, ibit19_l, ibit20_l) &
     6005       !$ACC PRIVATE(ibit21_s, ibit22_s, ibit23_s) &
     6006       !$ACC PRIVATE(flux_r, diss_r) &
     6007       !$ACC PRIVATE(flux_n, diss_n) &
     6008       !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) &
     6009       !$ACC PRIVATE(flux_l_w, diss_l_w, flux_s_w, diss_s_w) &
     6010       !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s, w_comp) &
     6011       !$ACC PRESENT(advc_flags_m) &
     6012       !$ACC PRESENT(u, v, w) &
     6013       !$ACC PRESENT(drho_air, rho_air_zw, ddzw) &
     6014       !$ACC PRESENT(tend) &
     6015       !$ACC PRESENT(hom(:,1,1:3,0)) &
     6016       !$ACC PRESENT(weight_substep(intermediate_timestep_count)) &
     6017       !$ACC PRESENT(sums_ws2_ws_l)
     6018       DO  i = nxl, nxr
     6019          DO  j = nys, nyn
     6020!
     6021!--          Used local modified copy of nzb_max (used to degrade order of
     6022!--          discretization) at non-cyclic boundaries. Modify only at relevant points
     6023!--          instead of the entire subdomain. This should lead to better
     6024!--          load balance between boundary and non-boundary PEs.
     6025             IF( ( bc_dirichlet_l  .OR.  bc_radiation_l )  .AND.  i <= nxl + 2  .OR. &
     6026                 ( bc_dirichlet_r  .OR.  bc_radiation_r )  .AND.  i >= nxr - 2  .OR. &
     6027                 ( bc_dirichlet_s  .OR.  bc_radiation_s )  .AND.  j <= nys + 2  .OR. &
     6028                 ( bc_dirichlet_n  .OR.  bc_radiation_n )  .AND.  j >= nyn - 2 )  THEN
     6029                nzb_max_l = nzt
     6030             ELSE
     6031                nzb_max_l = nzb_max
     6032             END IF
     6033
    59546034#ifndef _OPENACC
    5955 !
    5956 !--   compute the whole left boundary of the processor domain
    5957        i = nxl
    5958        DO  j = nys, nyn
    5959           DO  k = nzb+1, nzb_max_l
    5960 
    5961              ibit20 = REAL( IBITS(advc_flags_m(k,j,i-1),20,1), KIND = wp )
    5962              ibit19 = REAL( IBITS(advc_flags_m(k,j,i-1),19,1), KIND = wp )
    5963              ibit18 = REAL( IBITS(advc_flags_m(k,j,i-1),18,1), KIND = wp )
    5964 
    5965              u_comp                   = u(k+1,j,i) + u(k,j,i) - gu
    5966              swap_flux_x_local_w(k,j) = u_comp * (                             &
     6035             IF ( i == nxl )  THEN
     6036                DO  k = nzb+1, nzb_max_l
     6037                   ibit20 = REAL( IBITS(advc_flags_m(k,j,i-1),20,1), KIND = wp )
     6038                   ibit19 = REAL( IBITS(advc_flags_m(k,j,i-1),19,1), KIND = wp )
     6039                   ibit18 = REAL( IBITS(advc_flags_m(k,j,i-1),18,1), KIND = wp )
     6040
     6041                   u_comp(k)        = u(k+1,j,i) + u(k,j,i) - gu
     6042                   flux_l_w(k,j,tn) = u_comp(k) * (                            &
    59676043                                      ( 37.0_wp * ibit20 * adv_mom_5           &
    59686044                                   +     7.0_wp * ibit19 * adv_mom_3           &
     
    59776053                                      ) *                                      &
    59786054                                     ( w(k,j,i+2) + w(k,j,i-3) )               &
    5979                                                  )
    5980 
    5981                swap_diss_x_local_w(k,j) = - ABS( u_comp ) * (                  &
     6055                                                  )
     6056
     6057                   diss_l_w(k,j,tn) = - ABS( u_comp(k) ) * (                   &
    59826058                                        ( 10.0_wp * ibit20 * adv_mom_5         &
    59836059                                     +     3.0_wp * ibit19 * adv_mom_3         &
     
    59926068                                        ) *                                    &
    59936069                                     ( w(k,j,i+2) - w(k,j,i-3) )               &
    5994                                                             )
    5995 
    5996           ENDDO
    5997 
    5998           DO  k = nzb_max_l+1, nzt-1
    5999 
    6000              u_comp                   = u(k+1,j,i) + u(k,j,i) - gu
    6001              swap_flux_x_local_w(k,j) = u_comp * (                             &
    6002                             37.0_wp * ( w(k,j,i) + w(k,j,i-1)   )              &
    6003                           -  8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) )              &
    6004                           +           ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5
    6005              swap_diss_x_local_w(k,j) = - ABS( u_comp ) * (                    &
    6006                             10.0_wp * ( w(k,j,i) - w(k,j,i-1)   )              &
    6007                           -  5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) )              &
    6008                           +           ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5
    6009 
    6010           ENDDO
    6011 
    6012        ENDDO
     6070                                                           )
     6071
     6072                ENDDO
     6073
     6074                DO  k = nzb_max_l+1, nzt-1
     6075
     6076                   u_comp(k)        = u(k+1,j,i) + u(k,j,i) - gu
     6077                   flux_l_w(k,j,tn) = u_comp(k) * (                            &
     6078                               37.0_wp * ( w(k,j,i)   + w(k,j,i-1)   )         &
     6079                             -  8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) )           &
     6080                             +           ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5
     6081                   diss_l_w(k,j,tn) = - ABS( u_comp(k) ) * (                   &
     6082                               10.0_wp * ( w(k,j,i)   - w(k,j,i-1)   )         &
     6083                             -  5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) )           &
     6084                             +           ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5
     6085
     6086                ENDDO
     6087
     6088             ENDIF
     6089
     6090             IF ( j == nys )  THEN
     6091                DO  k = nzb+1, nzb_max_l
     6092
     6093                   ibit23 = REAL( IBITS(advc_flags_m(k,j-1,i),23,1), KIND = wp )
     6094                   ibit22 = REAL( IBITS(advc_flags_m(k,j-1,i),22,1), KIND = wp )
     6095                   ibit21 = REAL( IBITS(advc_flags_m(k,j-1,i),21,1), KIND = wp )
     6096
     6097                   v_comp(k)      = v(k+1,j,i) + v(k,j,i) - gv
     6098                   flux_s_w(k,tn) = v_comp(k) * (                               &
     6099                                       ( 37.0_wp * ibit23 * adv_mom_5           &
     6100                                    +     7.0_wp * ibit22 * adv_mom_3           &
     6101                                    +              ibit21 * adv_mom_1           &
     6102                                       ) *                                      &
     6103                                        ( w(k,j,i)   + w(k,j-1,i) )             &
     6104                                -      (  8.0_wp * ibit23 * adv_mom_5           &
     6105                                    +              ibit22 * adv_mom_3           &
     6106                                       ) *                                      &
     6107                                        ( w(k,j+1,i) + w(k,j-2,i) )             &
     6108                                +      (           ibit23 * adv_mom_5           &
     6109                                       ) *                                      &
     6110                                        ( w(k,j+2,i) + w(k,j-3,i) )             &
     6111                                                  )
     6112
     6113                   diss_s_w(k,tn) = - ABS( v_comp(k) ) * (                      &
     6114                                       ( 10.0_wp * ibit23 * adv_mom_5           &
     6115                                    +     3.0_wp * ibit22 * adv_mom_3           &
     6116                                    +              ibit21 * adv_mom_1           &
     6117                                       ) *                                      &
     6118                                        ( w(k,j,i)   - w(k,j-1,i) )             &
     6119                                -      (  5.0_wp * ibit23 * adv_mom_5           &
     6120                                    +              ibit22 * adv_mom_3           &
     6121                                       ) *                                      &
     6122                                        ( w(k,j+1,i) - w(k,j-2,i) )             &
     6123                                +      (           ibit23 * adv_mom_5           &
     6124                                       ) *                                      &
     6125                                        ( w(k,j+2,i) - w(k,j-3,i) )             &
     6126                                                           )
     6127
     6128                ENDDO
     6129
     6130                DO  k = nzb_max_l+1, nzt-1
     6131
     6132                   v_comp(k)      = v(k+1,j,i) + v(k,j,i) - gv
     6133                   flux_s_w(k,tn) = v_comp(k) * (                               &
     6134                              37.0_wp * ( w(k,j,i) + w(k,j-1,i)   )             &
     6135                            -  8.0_wp * ( w(k,j+1,i) +w(k,j-2,i)  )             &
     6136                            +           ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5
     6137                   diss_s_w(k,tn) = - ABS( v_comp(k) ) * (                      &
     6138                              10.0_wp * ( w(k,j,i) - w(k,j-1,i)   )             &
     6139                            -  5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) )             &
     6140                            +           ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5
     6141
     6142                ENDDO
     6143             ENDIF
    60136144#endif
    6014 
    6015        !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, gu, gv) &
    6016        !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) &
    6017        !$ACC PRIVATE(ibit18, ibit19, ibit20, ibit21, ibit22, ibit23) &
    6018        !$ACC PRIVATE(ibit18_l, ibit19_l, ibit20_l) &
    6019        !$ACC PRIVATE(ibit21_s, ibit22_s, ibit23_s) &
    6020        !$ACC PRIVATE(ibit24, ibit25, ibit26) &
    6021        !$ACC PRIVATE(flux_r, diss_r, flux_l, diss_l) &
    6022        !$ACC PRIVATE(flux_n, diss_n, flux_s, diss_s) &
    6023        !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) &
    6024        !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s, w_comp) &
    6025        !$ACC PRESENT(advc_flags_m) &
    6026        !$ACC PRESENT(u, v, w) &
    6027        !$ACC PRESENT(rho_air, drho_air_zw, ddzu) &
    6028        !$ACC PRESENT(tend) &
    6029        !$ACC PRESENT(hom(nzb+1:nzb_max_l,1,3,0)) &
    6030        !$ACC PRESENT(weight_substep(intermediate_timestep_count)) &
    6031        !$ACC PRESENT(sums_ws2_ws_l(nzb+1:nzb_max_l,0))
    6032        DO i = nxl, nxr
    6033 
    6034 #ifndef _OPENACC
    6035           j = nys
    6036           DO  k = nzb+1, nzb_max_l
    6037 
    6038              ibit23 = REAL( IBITS(advc_flags_m(k,j-1,i),23,1),  KIND = wp )
    6039              ibit22 = REAL( IBITS(advc_flags_m(k,j-1,i),22,1), KIND = wp )
    6040              ibit21 = REAL( IBITS(advc_flags_m(k,j-1,i),21,1), KIND = wp )
    6041 
    6042              v_comp                 = v(k+1,j,i) + v(k,j,i) - gv
    6043              swap_flux_y_local_w(k) = v_comp * (                               &
    6044                                     ( 37.0_wp * ibit23 * adv_mom_5             &
    6045                                  +     7.0_wp * ibit22 * adv_mom_3             &
    6046                                  +              ibit21 * adv_mom_1             &
    6047                                     ) *                                        &
    6048                                      ( w(k,j,i)   + w(k,j-1,i) )               &
    6049                              -      (  8.0_wp * ibit23 * adv_mom_5             &
    6050                                  +              ibit22 * adv_mom_3             &
    6051                                     ) *                                        &
    6052                                      ( w(k,j+1,i) + w(k,j-2,i) )               &
    6053                              +      (           ibit23 * adv_mom_5             &
    6054                                     ) *                                        &
    6055                                      ( w(k,j+2,i) + w(k,j-3,i) )               &
    6056                                                )
    6057 
    6058              swap_diss_y_local_w(k) = - ABS( v_comp ) * (                      &
    6059                                     ( 10.0_wp * ibit23 * adv_mom_5             &
    6060                                  +     3.0_wp * ibit22 * adv_mom_3             &
    6061                                  +              ibit21 * adv_mom_1             &
    6062                                     ) *                                        &
    6063                                      ( w(k,j,i)   - w(k,j-1,i) )               &
    6064                              -      (  5.0_wp * ibit23 * adv_mom_5             &
    6065                                  +              ibit22 * adv_mom_3             &
    6066                                     ) *                                        &
    6067                                      ( w(k,j+1,i) - w(k,j-2,i) )               &
    6068                              +      (           ibit23 * adv_mom_5             &
    6069                                     ) *                                        &
    6070                                      ( w(k,j+2,i) - w(k,j-3,i) )               &
    6071                                                         )
    6072 
    6073           ENDDO
    6074 
    6075           DO  k = nzb_max_l+1, nzt-1
    6076 
    6077              v_comp                 = v(k+1,j,i) + v(k,j,i) - gv
    6078              swap_flux_y_local_w(k) = v_comp * (                               &
    6079                            37.0_wp * ( w(k,j,i) + w(k,j-1,i)   )               &
    6080                          -  8.0_wp * ( w(k,j+1,i) +w(k,j-2,i)  )               &
    6081                          +           ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5
    6082              swap_diss_y_local_w(k) = - ABS( v_comp ) * (                      &
    6083                            10.0_wp * ( w(k,j,i) - w(k,j-1,i)   )               &
    6084                          -  5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) )               &
    6085                          +           ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5
    6086 
    6087           ENDDO
    6088 #endif
    6089 
    6090           DO  j = nys, nyn
    6091 
    6092 !
    6093 !--          The lower flux has to be calculated explicitly for the tendency
    6094 !--          at the first w-level. For topography wall this is done implicitely
    6095 !--          by advc_flags_m.
    6096              k      = nzb + 1
    6097              w_comp = w(k,j,i) + w(k-1,j,i)
    6098              flux_d = w_comp       * rho_air(k)                                &
    6099                     * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1
    6100              diss_d = -ABS(w_comp) * rho_air(k)                                &
    6101                     * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1
    6102 
    61036145             DO  k = nzb+1, nzb_max_l
    61046146
     
    61076149                ibit18 = REAL( IBITS(advc_flags_m(k,j,i),18,1), KIND = wp )
    61086150
    6109                 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu
    6110                 flux_r = u_comp * (                                            &
     6151                u_comp(k) = u(k+1,j,i+1) + u(k,j,i+1) - gu
     6152                flux_r(k) = u_comp(k) * (                                      &
    61116153                          ( 37.0_wp * ibit20 * adv_mom_5                       &
    61126154                       +     7.0_wp * ibit19 * adv_mom_3                       &
     
    61216163                          ) *                                                  &
    61226164                                 ( w(k,j,i+3) + w(k,j,i-2) )                   &
    6123                                      )
    6124 
    6125                 diss_r = - ABS( u_comp ) * (                                   &
     6165                                        )
     6166
     6167                diss_r(k) = - ABS( u_comp(k) ) * (                             &
    61266168                          ( 10.0_wp * ibit20 * adv_mom_5                       &
    61276169                       +     3.0_wp * ibit19 * adv_mom_3                       &
     
    61366178                          ) *                                                  &
    61376179                                 ( w(k,j,i+3) - w(k,j,i-2) )                   &
    6138                                               )
     6180                                                 )
    61396181
    61406182#ifdef _OPENACC
     
    61456187                ibit18_l = REAL( IBITS(advc_flags_m(k,j,i-1),18,1), KIND = wp )
    61466188
    6147                 u_comp_l = u(k+1,j,i) + u(k,j,i) - gu
    6148                 flux_l   = u_comp_l * (                                        &
     6189                u_comp_l           = u(k+1,j,i) + u(k,j,i) - gu
     6190                flux_l_w(k,j,tn)   = u_comp_l * (                              &
    61496191                                      ( 37.0_wp * ibit20_l * adv_mom_5         &
    61506192                                   +     7.0_wp * ibit19_l * adv_mom_3         &
     
    61596201                                      ) *                                      &
    61606202                                     ( w(k,j,i+2) + w(k,j,i-3) )               &
    6161                                                  )
    6162 
    6163                 diss_l   = - ABS( u_comp_l ) * (                               &
     6203                                                )
     6204
     6205                diss_l_w(k,j,tn)   = - ABS( u_comp_l ) * (                     &
    61646206                                        ( 10.0_wp * ibit20_l * adv_mom_5       &
    61656207                                     +     3.0_wp * ibit19_l * adv_mom_3       &
     
    61746216                                        ) *                                    &
    61756217                                     ( w(k,j,i+2) - w(k,j,i-3) )               &
    6176                                                             )
    6177 #else
    6178                 flux_l = swap_flux_x_local_w(k,j)
    6179                 diss_l = swap_diss_x_local_w(k,j)
     6218                                                         )
    61806219#endif
    61816220
     
    61856224                ibit21 = REAL( IBITS(advc_flags_m(k,j,i),21,1), KIND = wp )
    61866225
    6187                 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv
    6188                 flux_n = v_comp * (                                            &
     6226                v_comp(k) = v(k+1,j+1,i) + v(k,j+1,i) - gv
     6227                flux_n(k) = v_comp(k) * (                                      &
    61896228                          ( 37.0_wp * ibit23 * adv_mom_5                       &
    61906229                       +     7.0_wp * ibit22 * adv_mom_3                       &
     
    61996238                          ) *                                                  &
    62006239                                 ( w(k,j+3,i) + w(k,j-2,i) )                   &
    6201                                      )
    6202 
    6203                 diss_n = - ABS( v_comp ) * (                                   &
     6240                                        )
     6241
     6242                diss_n(k) = - ABS( v_comp(k) ) * (                             &
    62046243                          ( 10.0_wp * ibit23 * adv_mom_5                       &
    62056244                       +     3.0_wp * ibit22 * adv_mom_3                       &
     
    62146253                          ) *                                                  &
    62156254                                 ( w(k,j+3,i) - w(k,j-2,i) )                   &
    6216                                               )
     6255                                                 )
    62176256
    62186257#ifdef _OPENACC
     
    62236262                ibit21_s = REAL( IBITS(advc_flags_m(k,j-1,i),21,1), KIND = wp )
    62246263
    6225                 v_comp_s = v(k+1,j,i) + v(k,j,i) - gv
    6226                 flux_s   = v_comp_s * (                                        &
     6264                v_comp_s         = v(k+1,j,i) + v(k,j,i) - gv
     6265                flux_s_w(k,tn)   = v_comp_s * (                                &
    62276266                                    ( 37.0_wp * ibit23_s * adv_mom_5           &
    62286267                                 +     7.0_wp * ibit22_s * adv_mom_3           &
     
    62376276                                    ) *                                        &
    62386277                                     ( w(k,j+2,i) + w(k,j-3,i) )               &
    6239                                                )
    6240 
    6241                 diss_s   = - ABS( v_comp_s ) * (                               &
     6278                                              )
     6279
     6280                diss_s_w(k,tn)   = - ABS( v_comp_s ) * (                       &
    62426281                                    ( 10.0_wp * ibit23_s * adv_mom_5           &
    62436282                                 +     3.0_wp * ibit22_s * adv_mom_3           &
     
    62536292                                     ( w(k,j+2,i) - w(k,j-3,i) )               &
    62546293                                                        )
    6255 #else
    6256                 flux_s = swap_flux_y_local_w(k)
    6257                 diss_s = swap_diss_y_local_w(k)
    62586294#endif
    6259 
     6295             ENDDO
     6296
     6297             DO  k = nzb_max_l+1, nzt-1
     6298
     6299                u_comp(k) = u(k+1,j,i+1) + u(k,j,i+1) - gu
     6300                flux_r(k) = u_comp(k) * (                                      &
     6301                      37.0_wp * ( w(k,j,i+1) + w(k,j,i)   )                    &
     6302                    -  8.0_wp * ( w(k,j,i+2) + w(k,j,i-1) )                    &
     6303                    +           ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_5
     6304
     6305                diss_r(k) = - ABS( u_comp(k) ) * (                             &
     6306                      10.0_wp * ( w(k,j,i+1) - w(k,j,i)   )                    &
     6307                    -  5.0_wp * ( w(k,j,i+2) - w(k,j,i-1) )                    &
     6308                    +           ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_5
     6309
     6310#ifdef _OPENACC
     6311!
     6312!--             Recompute the left fluxes.
     6313                u_comp_l           = u(k+1,j,i) + u(k,j,i) - gu
     6314                flux_l_w(k,j,tn)   = u_comp_l * (                              &
     6315                            37.0_wp * ( w(k,j,i)   + w(k,j,i-1)   )            &
     6316                          -  8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) )              &
     6317                          +           ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5
     6318                diss_l_w(k,j,tn)   = - ABS( u_comp_l ) * (                     &
     6319                            10.0_wp * ( w(k,j,i)   - w(k,j,i-1)   )            &
     6320                          -  5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) )              &
     6321                          +           ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5
     6322#endif
     6323
     6324                v_comp(k) = v(k+1,j+1,i) + v(k,j+1,i) - gv
     6325                flux_n(k) = v_comp(k) * (                                      &
     6326                      37.0_wp * ( w(k,j+1,i) + w(k,j,i)   )                    &
     6327                    -  8.0_wp * ( w(k,j+2,i) + w(k,j-1,i) )                    &
     6328                    +           ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_5
     6329
     6330                diss_n(k) = - ABS( v_comp(k) ) * (                             &
     6331                      10.0_wp * ( w(k,j+1,i) - w(k,j,i)   )                    &
     6332                    -  5.0_wp * ( w(k,j+2,i) - w(k,j-1,i) )                    &
     6333                    +           ( w(k,j+3,i) - w(k,j-2,i) ) ) * adv_mom_5
     6334
     6335#ifdef _OPENACC
     6336!
     6337!--             Recompute the south fluxes.
     6338                v_comp_s         = v(k+1,j,i) + v(k,j,i) - gv
     6339                flux_s_w(k,tn)   = v_comp_s * (                                &
     6340                           37.0_wp * ( w(k,j,i)   + w(k,j-1,i) )               &
     6341                         -  8.0_wp * ( w(k,j+1,i) + w(k,j-2,i)  )              &
     6342                         +           ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5
     6343                diss_s_w(k,tn)   = - ABS( v_comp_s ) * (                       &
     6344                           10.0_wp * ( w(k,j,i)   - w(k,j-1,i) )               &
     6345                         -  5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) )               &
     6346                         +           ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5
     6347#endif
     6348             ENDDO
     6349!
     6350!--          Now, compute vertical fluxes. Split loop into a part treating the
     6351!--          lowest grid points with indirect indexing, a main loop without
     6352!--          indirect indexing, and a loop for the uppermost grip points with
     6353!--          indirect indexing. This allows better vectorization for the main loop.
     6354!--          First, compute the flux at model surface, which need has to be
     6355!--          calculated explicitly for the tendency at
     6356!--          the first w-level. For topography wall this is done implicitely by
     6357!--          advc_flags_m.
     6358             k         = nzb + 1
     6359             w_comp(k) = w(k,j,i) + w(k-1,j,i)
     6360             flux_t(0) = w_comp(k)       * rho_air(k)                          &
     6361                       * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1
     6362             diss_t(0) = -ABS(w_comp(k)) * rho_air(k)                          &
     6363                       * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1
     6364
     6365             DO  k = nzb+1, nzb+1
    62606366!
    62616367!--             k index has to be modified near bottom and top, else array
     
    62696375                k_mm  = k - 2 * ibit26
    62706376
    6271                 w_comp = w(k+1,j,i) + w(k,j,i)
    6272                 flux_t = w_comp * rho_air(k+1) * (                             &
    6273                           ( 37.0_wp * ibit26 * adv_mom_5                       &
    6274                        +     7.0_wp * ibit25 * adv_mom_3                       &
    6275                        +              ibit24 * adv_mom_1                       &
    6276                           ) *                                                  &
    6277                              ( w(k+1,j,i)  + w(k,j,i)     )                    &
    6278                    -      (  8.0_wp * ibit26 * adv_mom_5                       &
    6279                        +              ibit25 * adv_mom_3                       &
    6280                           ) *                                                  &
    6281                              ( w(k_pp,j,i)  + w(k-1,j,i)  )                    &
    6282                    +      (           ibit26 * adv_mom_5                       &
    6283                           ) *                                                  &
    6284                              ( w(k_ppp,j,i) + w(k_mm,j,i) )                    &
    6285                                        )
    6286 
    6287                 diss_t = - ABS( w_comp ) * rho_air(k+1) * (                    &
    6288                           ( 10.0_wp * ibit26 * adv_mom_5                       &
    6289                        +     3.0_wp * ibit25 * adv_mom_3                       &
    6290                        +              ibit24 * adv_mom_1                       &
    6291                           ) *                                                  &
    6292                              ( w(k+1,j,i)   - w(k,j,i)    )                    &
    6293                    -      (  5.0_wp * ibit26 * adv_mom_5                       &
    6294                        +              ibit25 * adv_mom_3                       &
    6295                           ) *                                                  &
    6296                              ( w(k_pp,j,i)  - w(k-1,j,i)  )                    &
    6297                    +      (           ibit26 * adv_mom_5                       &
    6298                           ) *                                                  &
    6299                              ( w(k_ppp,j,i) - w(k_mm,j,i) )                    &
    6300                                                )
    6301 !
    6302 !--             Calculate the divergence of the velocity field. A respective
    6303 !--             correction is needed to overcome numerical instabilities caused
    6304 !--             by a not sufficient reduction of divergences near topography.
    6305                 div = ( ( ( u_comp + gu ) * ( ibit18 + ibit19 + ibit20 )      &
    6306                   - ( u(k+1,j,i) + u(k,j,i)   )                               &
    6307                                     * (                                       &
    6308                      REAL( IBITS(advc_flags_m(k,j,i-1),18,1), KIND = wp )     &
    6309                    + REAL( IBITS(advc_flags_m(k,j,i-1),19,1), KIND = wp )     &
    6310                    + REAL( IBITS(advc_flags_m(k,j,i-1),20,1), KIND = wp )     &
    6311                                       )                                       &
    6312                   ) * ddx                                                     &
    6313               +   ( ( v_comp + gv ) * ( ibit21 + ibit22 + ibit23 )            &
    6314                   - ( v(k+1,j,i) + v(k,j,i)   )                               &
    6315                                     * (                                       &
    6316                      REAL( IBITS(advc_flags_m(k,j-1,i),21,1), KIND = wp )     &
    6317                    + REAL( IBITS(advc_flags_m(k,j-1,i),22,1), KIND = wp )     &
    6318                    + REAL( IBITS(advc_flags_m(k,j-1,i),23,1),  KIND = wp )    &
    6319                                       )                                       &
    6320                   ) * ddy                                                     &
    6321               +   ( w_comp * rho_air(k+1) * ( ibit24 + ibit25 + ibit26 )      &
    6322                 - ( w(k,j,i)   + w(k-1,j,i)   ) * rho_air(k)                  &
    6323                                     * (                                       &
    6324                      REAL( IBITS(advc_flags_m(k-1,j,i),24,1), KIND = wp )     &
    6325                    + REAL( IBITS(advc_flags_m(k-1,j,i),25,1), KIND = wp )     &
    6326                    + REAL( IBITS(advc_flags_m(k-1,j,i),26,1), KIND = wp )     &
    6327                                       )                                       &
    6328                   ) * drho_air_zw(k) * ddzu(k+1)                              &
    6329                 ) * 0.5_wp
    6330 
    6331 
    6332 
    6333                 tend(k,j,i) = tend(k,j,i) - (                                 &
    6334                       ( ( flux_r + diss_r )                                   &
    6335                     -   ( flux_l + diss_l ) ) * ddx                           &
    6336                     + ( ( flux_n + diss_n )                                   &
    6337                     -   ( flux_s + diss_s ) ) * ddy                           &
    6338                     + ( ( flux_t + diss_t )                                   &
    6339                     -   ( flux_d + diss_d ) ) * drho_air_zw(k) * ddzu(k+1)    &
    6340                                             )  + div * w(k,j,i)
    6341 
    6342 #ifndef _OPENACC
    6343                 swap_flux_x_local_w(k,j) = flux_r
    6344                 swap_diss_x_local_w(k,j) = diss_r
    6345                 swap_flux_y_local_w(k)   = flux_n
    6346                 swap_diss_y_local_w(k)   = diss_n
    6347 #endif
    6348                 flux_d                   = flux_t
    6349                 diss_d                   = diss_t
    6350 
    6351                 !$ACC ATOMIC
    6352                 sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                    &
    6353                       + ( flux_t                                              &
    6354                        * ( w_comp - 2.0_wp * hom(k,1,3,0)                   ) &
    6355                        / ( w_comp + SIGN( 1.0E-20_wp, w_comp )              ) &
    6356                         + diss_t                                              &
    6357                        *   ABS( w_comp - 2.0_wp * hom(k,1,3,0)              ) &
    6358                        / ( ABS( w_comp ) + 1.0E-20_wp                       ) &
    6359                         ) *   weight_substep(intermediate_timestep_count)
    6360 
     6377                w_comp(k) = w(k+1,j,i) + w(k,j,i)
     6378                flux_t(k) = w_comp(k) * rho_air(k+1) * (                       &
     6379                           ( 37.0_wp * ibit26 * adv_mom_5                      &
     6380                        +     7.0_wp * ibit25 * adv_mom_3                      &
     6381                        +              ibit24 * adv_mom_1                      &
     6382                           ) *                                                 &
     6383                                      ( w(k+1,j,i)   + w(k,j,i)    )           &
     6384                    -      (  8.0_wp * ibit26 * adv_mom_5                      &
     6385                        +              ibit25 * adv_mom_3                      &
     6386                           ) *                                                 &
     6387                                      ( w(k_pp,j,i)  + w(k-1,j,i)  )           &
     6388                    +      (           ibit26 * adv_mom_5                      &
     6389                           ) *                                                 &
     6390                                      ( w(k_ppp,j,i) + w(k_mm,j,i) )           &
     6391                                                       )
     6392
     6393                diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (              &
     6394                           ( 10.0_wp * ibit26 * adv_mom_5                      &
     6395                        +     3.0_wp * ibit25 * adv_mom_3                      &
     6396                        +              ibit24 * adv_mom_1                      &
     6397                           ) *                                                 &
     6398                                      ( w(k+1,j,i)   - w(k,j,i)    )           &
     6399                    -      (  5.0_wp * ibit26 * adv_mom_5                      &
     6400                        +              ibit25 * adv_mom_3                      &
     6401                           ) *                                                 &
     6402                                      ( w(k_pp,j,i)  - w(k-1,j,i)  )           &
     6403                    +      (           ibit26 * adv_mom_5                      &
     6404                           ) *                                                 &
     6405                                      ( w(k_ppp,j,i) - w(k_mm,j,i) )           &
     6406                                                                )
    63616407             ENDDO
    63626408
    6363              DO  k = nzb_max_l+1, nzt-1
    6364 
    6365                 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu
    6366                 flux_r = u_comp * (                                         &
    6367                       37.0_wp * ( w(k,j,i+1) + w(k,j,i)   )                    &
    6368                     -  8.0_wp * ( w(k,j,i+2) + w(k,j,i-1) )                    &
    6369                     +           ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_5
    6370 
    6371                 diss_r = - ABS( u_comp ) * (                                &
    6372                       10.0_wp * ( w(k,j,i+1) - w(k,j,i)   )                    &
    6373                     -  5.0_wp * ( w(k,j,i+2) - w(k,j,i-1) )                    &
    6374                     +           ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_5
    6375 
    6376 #ifdef _OPENACC
    6377 !
    6378 !--             Recompute the left fluxes.
    6379                 u_comp_l = u(k+1,j,i) + u(k,j,i) - gu
    6380                 flux_l   = u_comp_l * (                                     &
    6381                             37.0_wp * ( w(k,j,i)   + w(k,j,i-1)   )              &
    6382                           -  8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) )              &
    6383                           +           ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5
    6384                 diss_l   = - ABS( u_comp_l ) * (                            &
    6385                             10.0_wp * ( w(k,j,i)   - w(k,j,i-1)   )              &
    6386                           -  5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) )              &
    6387                           +           ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5
    6388 #else
    6389                 flux_l = swap_flux_x_local_w(k,j)
    6390                 diss_l = swap_diss_x_local_w(k,j)
    6391 #endif
    6392 
    6393                 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv
    6394                 flux_n = v_comp * (                                         &
    6395                       37.0_wp * ( w(k,j+1,i) + w(k,j,i)   )                    &
    6396                     -  8.0_wp * ( w(k,j+2,i) + w(k,j-1,i) )                    &
    6397                     +           ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_5
    6398 
    6399                 diss_n = - ABS( v_comp ) * (                                &
    6400                       10.0_wp * ( w(k,j+1,i) - w(k,j,i)   )                    &
    6401                     -  5.0_wp * ( w(k,j+2,i) - w(k,j-1,i) )                    &
    6402                     +           ( w(k,j+3,i) - w(k,j-2,i) ) ) * adv_mom_5
    6403 
    6404 #ifdef _OPENACC
    6405 !
    6406 !--             Recompute the south fluxes.
    6407                 v_comp_s = v(k+1,j,i) + v(k,j,i) - gv
    6408                 flux_s   = v_comp_s * (                                     &
    6409                            37.0_wp * ( w(k,j,i)   + w(k,j-1,i) )               &
    6410                          -  8.0_wp * ( w(k,j+1,i) +w(k,j-2,i)  )               &
    6411                          +           ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5
    6412                 diss_s   = - ABS( v_comp_s ) * (                            &
    6413                            10.0_wp * ( w(k,j,i)   - w(k,j-1,i) )               &
    6414                          -  5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) )               &
    6415                          +           ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5
    6416 #else
    6417                 flux_s = swap_flux_y_local_w(k)
    6418                 diss_s = swap_diss_y_local_w(k)
    6419 #endif
    6420 
     6409             DO  k = nzb+2, nzt-2
     6410
     6411                ibit26 = REAL( IBITS(advc_flags_m(k,j,i),26,1), KIND = wp )
     6412                ibit25 = REAL( IBITS(advc_flags_m(k,j,i),25,1), KIND = wp )
     6413                ibit24 = REAL( IBITS(advc_flags_m(k,j,i),24,1), KIND = wp )
     6414
     6415                w_comp(k) = w(k+1,j,i) + w(k,j,i)
     6416                flux_t(k) = w_comp(k) * rho_air(k+1) * (                       &
     6417                           ( 37.0_wp * ibit26 * adv_mom_5                      &
     6418                        +     7.0_wp * ibit25 * adv_mom_3                      &
     6419                        +              ibit24 * adv_mom_1                      &
     6420                           ) *                                                 &
     6421                                      ( w(k+1,j,i)  + w(k,j,i)   )             &
     6422                    -      (  8.0_wp * ibit26 * adv_mom_5                      &
     6423                        +              ibit25 * adv_mom_3                      &
     6424                           ) *                                                 &
     6425                                      ( w(k+2,j,i)  + w(k-1,j,i) )             &
     6426                    +      (           ibit26 * adv_mom_5                      &
     6427                           ) *                                                 &
     6428                                      ( w(k+3,j,i)  + w(k-2,j,i) )             &
     6429                                                       )
     6430
     6431                diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (              &
     6432                           ( 10.0_wp * ibit26 * adv_mom_5                      &
     6433                        +     3.0_wp * ibit25 * adv_mom_3                      &
     6434                        +              ibit24 * adv_mom_1                      &
     6435                           ) *                                                 &
     6436                                      ( w(k+1,j,i) - w(k,j,i)    )             &
     6437                    -      (  5.0_wp * ibit26 * adv_mom_5                      &
     6438                        +              ibit25 * adv_mom_3                      &
     6439                           ) *                                                 &
     6440                                      ( w(k+2,j,i) - w(k-1,j,i)  )             &
     6441                    +      (           ibit26 * adv_mom_5                      &
     6442                           ) *                                                 &
     6443                                      ( w(k+3,j,i) - w(k-2,j,i)  )             &
     6444                                                                )
     6445             ENDDO
     6446
     6447             DO  k = nzt-1, nzt-1
    64216448!
    64226449!--             k index has to be modified near bottom and top, else array
     
    64306457                k_mm  = k - 2 * ibit26
    64316458
    6432                 w_comp = w(k+1,j,i) + w(k,j,i)
    6433                 flux_t = w_comp * rho_air(k+1) * (                           &
    6434                           ( 37.0_wp * ibit26 * adv_mom_5                        &
    6435                        +     7.0_wp * ibit25 * adv_mom_3                        &
    6436                        +              ibit24 * adv_mom_1                        &
    6437                           ) *                                                &
    6438                              ( w(k+1,j,i)  + w(k,j,i)     )                  &
    6439                    -      (  8.0_wp * ibit26 * adv_mom_5                        &
    6440                        +              ibit25 * adv_mom_3                        &
    6441                           ) *                                                &
    6442                              ( w(k_pp,j,i)  + w(k-1,j,i)  )                  &
    6443                    +      (           ibit26 * adv_mom_5                        &
    6444                           ) *                                                &
    6445                              ( w(k_ppp,j,i) + w(k_mm,j,i) )                  &
    6446                                        )
    6447 
    6448                 diss_t = - ABS( w_comp ) * rho_air(k+1) * (                  &
    6449                           ( 10.0_wp * ibit26 * adv_mom_5                        &
    6450                        +     3.0_wp * ibit25 * adv_mom_3                        &
    6451                        +              ibit24 * adv_mom_1                        &
    6452                           ) *                                                &
    6453                              ( w(k+1,j,i)   - w(k,j,i)    )                  &
    6454                    -      (  5.0_wp * ibit26 * adv_mom_5                        &
    6455                        +              ibit25 * adv_mom_3                        &
    6456                           ) *                                                &
    6457                              ( w(k_pp,j,i)  - w(k-1,j,i)  )                  &
    6458                    +      (           ibit26 * adv_mom_5                        &
    6459                           ) *                                                &
    6460                              ( w(k_ppp,j,i) - w(k_mm,j,i) )                  &
    6461                                                )
     6459                w_comp(k) = w(k+1,j,i) + w(k,j,i)
     6460                flux_t(k) = w_comp(k) * rho_air(k+1) * (                       &
     6461                           ( 37.0_wp * ibit26 * adv_mom_5                      &
     6462                        +     7.0_wp * ibit25 * adv_mom_3                      &
     6463                        +              ibit24 * adv_mom_1                      &
     6464                           ) *                                                 &
     6465                                      ( w(k+1,j,i)   + w(k,j,i)    )           &
     6466                    -      (  8.0_wp * ibit26 * adv_mom_5                      &
     6467                        +              ibit25 * adv_mom_3                      &
     6468                           ) *                                                 &
     6469                                      ( w(k_pp,j,i)  + w(k-1,j,i)  )           &
     6470                    +      (           ibit26 * adv_mom_5                      &
     6471                           ) *                                                 &
     6472                                      ( w(k_ppp,j,i) + w(k_mm,j,i) )           &
     6473                                                       )
     6474
     6475                diss_t(k) = - ABS( w_comp(k) ) * rho_air(k+1) * (              &
     6476                           ( 10.0_wp * ibit26 * adv_mom_5                      &
     6477                        +     3.0_wp * ibit25 * adv_mom_3                      &
     6478                        +              ibit24 * adv_mom_1                      &
     6479                           ) *                                                 &
     6480                                      ( w(k+1,j,i)   - w(k,j,i)    )           &
     6481                    -      (  5.0_wp * ibit26 * adv_mom_5                      &
     6482                        +              ibit25 * adv_mom_3                      &
     6483                           ) *                                                 &
     6484                                      ( w(k_pp,j,i)  - w(k-1,j,i)  )           &
     6485                    +      (           ibit26 * adv_mom_5                      &
     6486                           ) *                                                 &
     6487                                      ( w(k_ppp,j,i) - w(k_mm,j,i) )           &
     6488                                                                )
     6489             ENDDO
     6490
     6491!
     6492!--          Set resolved/turbulent flux at model top to zero (w-level). Hint: The
     6493!--          flux at nzt is defined at the scalar grid point nzt+1. Therefore, the
     6494!--          flux at nzt+1 is already outside of the model domain
     6495             flux_t(nzt) = 0.0_wp
     6496             diss_t(nzt) = 0.0_wp
     6497             w_comp(nzt) = 0.0_wp
     6498
     6499             flux_t(nzt+1) = 0.0_wp
     6500             diss_t(nzt+1) = 0.0_wp
     6501             w_comp(nzt+1) = 0.0_wp
     6502
     6503             DO  k = nzb+1, nzb_max_l
     6504
     6505                flux_d    = flux_t(k-1)
     6506                diss_d    = diss_t(k-1)
     6507
     6508                ibit20 = REAL( IBITS(advc_flags_m(k,j,i),20,1), KIND = wp )
     6509                ibit19 = REAL( IBITS(advc_flags_m(k,j,i),19,1), KIND = wp )
     6510                ibit18 = REAL( IBITS(advc_flags_m(k,j,i),18,1), KIND = wp )
     6511
     6512                ibit23 = REAL( IBITS(advc_flags_m(k,j,i),23,1), KIND = wp )
     6513                ibit22 = REAL( IBITS(advc_flags_m(k,j,i),22,1), KIND = wp )
     6514                ibit21 = REAL( IBITS(advc_flags_m(k,j,i),21,1), KIND = wp )
     6515
     6516                ibit26 = REAL( IBITS(advc_flags_m(k,j,i),26,1), KIND = wp )
     6517                ibit25 = REAL( IBITS(advc_flags_m(k,j,i),25,1), KIND = wp )
     6518                ibit24 = REAL( IBITS(advc_flags_m(k,j,i),24,1), KIND = wp )
    64626519!
    64636520!--             Calculate the divergence of the velocity field. A respective
    6464 !--             correction is needed to overcome numerical instabilities caused
     6521!--             correction is needed to overcome numerical instabilities introduced
    64656522!--             by a not sufficient reduction of divergences near topography.
    6466                 div = ( ( u_comp + gu - ( u(k+1,j,i) + u(k,j,i)   ) ) * ddx  &
    6467                     +   ( v_comp + gv - ( v(k+1,j,i) + v(k,j,i)   ) ) * ddy  &
    6468                     +   (   w_comp                    * rho_air(k+1) -       &
    6469                           ( w(k,j,i)   + w(k-1,j,i) ) * rho_air(k)           &
    6470                         ) * drho_air_zw(k) * ddzu(k+1)                       &
     6523                div = ( ( ( u_comp(k) + gu ) * ( ibit18 + ibit19 + ibit20 )     &
     6524                        - ( u(k+1,j,i) + u(k,j,i)   )                           &
     6525                                          * (                                   &
     6526                           REAL( IBITS(advc_flags_m(k,j,i-1),18,1), KIND = wp ) &
     6527                         + REAL( IBITS(advc_flags_m(k,j,i-1),19,1), KIND = wp ) &
     6528                         + REAL( IBITS(advc_flags_m(k,j,i-1),20,1), KIND = wp ) &
     6529                                            )                                   &
     6530                        ) * ddx                                                 &
     6531                    +   ( ( v_comp(k) + gv ) * ( ibit21 + ibit22 + ibit23 )     &
     6532                        - ( v(k+1,j,i) + v(k,j,i)   )                           &
     6533                                          * (                                   &
     6534                           REAL( IBITS(advc_flags_m(k,j-1,i),21,1), KIND = wp ) &
     6535                         + REAL( IBITS(advc_flags_m(k,j-1,i),22,1), KIND = wp ) &
     6536                         + REAL( IBITS(advc_flags_m(k,j-1,i),23,1), KIND = wp ) &
     6537                                            )                                   &
     6538                        ) * ddy                                                 &
     6539                    +   ( w_comp(k)               * rho_air(k+1)                &
     6540                                                  * ( ibit24 + ibit25 + ibit26 )&
     6541                      - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k)                  &
     6542                                          * (                                   &
     6543                           REAL( IBITS(advc_flags_m(k-1,j,i),24,1), KIND = wp ) &
     6544                         + REAL( IBITS(advc_flags_m(k-1,j,i),25,1), KIND = wp ) &
     6545                         + REAL( IBITS(advc_flags_m(k-1,j,i),26,1), KIND = wp ) &
     6546                                            )                                   &
     6547                        ) * drho_air_zw(k) * ddzu(k+1)                          &
    64716548                      ) * 0.5_wp
    64726549
    6473                 tend(k,j,i) = tend(k,j,i) - (                                 &
    6474                       ( ( flux_r + diss_r )                                   &
    6475                     -   ( flux_l + diss_l ) ) * ddx                           &
    6476                     + ( ( flux_n + diss_n )                                   &
    6477                     -   ( flux_s + diss_s ) ) * ddy                           &
    6478                     + ( ( flux_t + diss_t )                                   &
    6479                     -   ( flux_d + diss_d ) ) * drho_air_zw(k) * ddzu(k+1)    &
    6480                                             )  + div * w(k,j,i)
    6481 
     6550                tend(k,j,i) = tend(k,j,i) - (                                   &
     6551                            ( flux_r(k) + diss_r(k)                             &
     6552                          -   flux_l_w(k,j,tn) - diss_l_w(k,j,tn)   ) * ddx     &
     6553                          + ( flux_n(k) + diss_n(k)                             &
     6554                          -   flux_s_w(k,tn) - diss_s_w(k,tn)       ) * ddy     &
     6555                          + ( ( flux_t(k) + diss_t(k) )                         &
     6556                          -   ( flux_d    + diss_d    )                         &
     6557                                                ) * drho_air_zw(k) * ddzu(k+1)  &
     6558                                            ) + div * w(k,j,i)
    64826559#ifndef _OPENACC
    6483                 swap_flux_x_local_w(k,j) = flux_r
    6484                 swap_diss_x_local_w(k,j) = diss_r
    6485                 swap_flux_y_local_w(k)   = flux_n
    6486                 swap_diss_y_local_w(k)   = diss_n
     6560                flux_l_w(k,j,tn) = flux_r(k)
     6561                diss_l_w(k,j,tn) = diss_r(k)
     6562                flux_s_w(k,tn)   = flux_n(k)
     6563                diss_s_w(k,tn)   = diss_n(k)
    64876564#endif
    6488                 flux_d                   = flux_t
    6489                 diss_d                   = diss_t
    6490 
    6491                 !$ACC ATOMIC
    6492                 sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                    &
    6493                       + ( flux_t                                              &
    6494                        * ( w_comp - 2.0_wp * hom(k,1,3,0)                   ) &
    6495                        / ( w_comp + SIGN( 1.0E-20_wp, w_comp )              ) &
    6496                         + diss_t                                              &
    6497                        *   ABS( w_comp - 2.0_wp * hom(k,1,3,0)              ) &
    6498                        / ( ABS( w_comp ) + 1.0E-20_wp                       ) &
    6499                         ) *   weight_substep(intermediate_timestep_count)
     6565!
     6566!--             Statistical Evaluation of w'w'.
     6567                sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                     &
     6568                            + ( flux_t(k)                                      &
     6569                             * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)           ) &
     6570                             / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )   ) &
     6571                              + diss_t(k)                                      &
     6572                             *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)      ) &
     6573                             / ( ABS( w_comp(k) ) + 1.0E-20_wp               ) &
     6574                              ) *   weight_substep(intermediate_timestep_count)
    65006575
    65016576             ENDDO
     6577
     6578             DO  k = nzb_max_l+1, nzt-1
     6579
     6580                flux_d    = flux_t(k-1)
     6581                diss_d    = diss_t(k-1)
     6582!
     6583!--             Calculate the divergence of the velocity field. A respective
     6584!--             correction is needed to overcome numerical instabilities introduced
     6585!--             by a not sufficient reduction of divergences near topography.
     6586                div = ( ( u_comp(k) + gu - ( u(k+1,j,i) + u(k,j,i)   ) ) * ddx &
     6587                    +   ( v_comp(k) + gv - ( v(k+1,j,i) + v(k,j,i)   ) ) * ddy &
     6588                    +   ( w_comp(k)               * rho_air(k+1)               &
     6589                      - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k)                 &
     6590                        ) * drho_air_zw(k) * ddzu(k+1)                         &
     6591                      ) * 0.5_wp
     6592
     6593                tend(k,j,i) = tend(k,j,i) - (                                  &
     6594                            ( flux_r(k) + diss_r(k)                            &
     6595                          -   flux_l_w(k,j,tn) - diss_l_w(k,j,tn)   ) * ddx    &
     6596                          + ( flux_n(k) + diss_n(k)                            &
     6597                          -   flux_s_w(k,tn) - diss_s_w(k,tn)       ) * ddy    &
     6598                          + ( ( flux_t(k) + diss_t(k) )                        &
     6599                          -   ( flux_d    + diss_d    )                        &
     6600                                               ) * drho_air_zw(k) * ddzu(k+1)  &
     6601                                            ) + div * w(k,j,i)
     6602#ifndef _OPENACC
     6603                flux_l_w(k,j,tn) = flux_r(k)
     6604                diss_l_w(k,j,tn) = diss_r(k)
     6605                flux_s_w(k,tn)   = flux_n(k)
     6606                diss_s_w(k,tn)   = diss_n(k)
     6607#endif
     6608!
     6609!--             Statistical Evaluation of w'w'.
     6610                sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                     &
     6611                            + ( flux_t(k)                                      &
     6612                             * ( w_comp(k) - 2.0_wp * hom(k,1,3,0)          )  &
     6613                             / ( w_comp(k) + SIGN( 1.0E-20_wp, w_comp(k) )  )  &
     6614                              + diss_t(k)                                      &
     6615                             *   ABS( w_comp(k) - 2.0_wp * hom(k,1,3,0)     )  &
     6616                             / ( ABS( w_comp(k) ) + 1.0E-20_wp              )  &
     6617                              ) *   weight_substep(intermediate_timestep_count)
     6618
     6619             ENDDO
     6620
    65026621          ENDDO
    65036622       ENDDO
    65046623
     6624       CALL cpu_log( log_point_s(87), 'advec_w_ws', 'stop' )
     6625
    65056626    END SUBROUTINE advec_w_ws
    65066627
  • palm/trunk/SOURCE/time_integration.f90

    r4457 r4466  
    2525! -----------------
    2626! $Id$
     27! Add advection fluxes to ACC copyin
     28!
     29! 4457 2020-03-11 14:20:43Z raasch
    2730! use statement for exchange horiz added
    28 ! 
     31!
    2932! 4444 2020-03-05 15:59:50Z raasch
    3033! bugfix: cpp-directives for serial mode added
    31 ! 
     34!
    3235! 4420 2020-02-24 14:13:56Z maronga
    3336! Added output control for wind turbine model
    34 ! 
     37!
    3538! 4403 2020-02-12 13:08:46Z banzhafs
    3639! Allowing both existing and on-demand emission read modes
     
    3841! 4360 2020-01-07 11:25:50Z suehring
    3942! Bugfix, hour_call_emis uninitialized at first call of time_integration
    40 ! 
     43!
    4144! 4346 2019-12-18 11:55:56Z motisi
    4245! Introduction of wall_flags_total_0, which currently sets bits based on static
    4346! topography information used in wall_flags_static_0
    44 ! 
     47!
    4548! 4329 2019-12-10 15:46:36Z motisi
    4649! Renamed wall_flags_0 to wall_flags_static_0
    47 ! 
     50!
    4851! 4281 2019-10-29 15:15:39Z schwenkel
    4952! Moved boundary conditions to module interface
    50 ! 
     53!
    5154! 4276 2019-10-28 16:03:29Z schwenkel
    5255! Further modularization of lpm code components
    53 ! 
     56!
    5457! 4275 2019-10-28 15:34:55Z schwenkel
    5558! Move call oft lpm to the end of intermediate timestep loop
     
    6063! 4227 2019-09-10 18:04:34Z gronemeier
    6164! implement new palm_date_time_mod
    62 ! 
     65!
    6366! 4226 2019-09-10 17:03:24Z suehring
    6467! Changes in interface for the offline nesting
    65 ! 
     68!
    6669! 4182 2019-08-22 15:20:23Z scharf
    6770! Corrected "Former revisions" section
    68 ! 
     71!
    6972! 4170 2019-08-19 17:12:31Z gronemeier
    7073! copy diss, diss_p, tdiss_m to GPU
    71 ! 
     74!
    7275! 4144 2019-08-06 09:11:47Z raasch
    7376! relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
    74 ! 
     77!
    7578! 4126 2019-07-30 11:09:11Z gronemeier
    7679! renamed routine to calculate uv exposure
    77 ! 
     80!
    7881! 4111 2019-07-22 18:16:57Z suehring
    7982! advc_flags_1 / advc_flags_2 renamed to advc_flags_m / advc_flags_s
    80 ! 
     83!
    8184! 4069 2019-07-01 14:05:51Z Giersch
    82 ! Masked output running index mid has been introduced as a local variable to 
     85! Masked output running index mid has been introduced as a local variable to
    8386! avoid runtime error (Loop variable has been modified) in time_integration
    84 ! 
     87!
    8588! 4064 2019-07-01 05:33:33Z gronemeier
    8689! Moved call to radiation module out of intermediate time loop
    87 ! 
     90!
    8891! 4048 2019-06-21 21:00:21Z knoop
    8992! Moved production_e_init call into turbulence_closure_mod
    90 ! 
     93!
    9194! 4047 2019-06-21 18:58:09Z knoop
    9295! Added remainings of swap_timelevel upon its dissolution
    93 ! 
     96!
    9497! 4043 2019-06-18 16:59:00Z schwenkel
    9598! Further LPM modularization
     
    97100! 4039 2019-06-18 10:32:41Z suehring
    98101! Rename subroutines in module for diagnostic quantities
    99 ! 
     102!
    100103! 4029 2019-06-14 14:04:35Z raasch
    101104! exchange of ghost points and boundary conditions separated for chemical species and SALSA module,
    102105! bugfix: decycling of chemistry species after nesting data transfer
    103 ! 
     106!
    104107! 4022 2019-06-12 11:52:39Z suehring
    105108! Call synthetic turbulence generator at last RK3 substep right after boundary
    106 ! conditions are updated in offline nesting in order to assure that 
    107 ! perturbations are always imposed 
    108 ! 
     109! conditions are updated in offline nesting in order to assure that
     110! perturbations are always imposed
     111!
    109112! 4017 2019-06-06 12:16:46Z schwenkel
    110113! Mass (volume) flux correction included to ensure global mass conservation for child domains.
    111 ! 
     114!
    112115! 3994 2019-05-22 18:08:09Z suehring
    113116! output of turbulence intensity added
    114 ! 
     117!
    115118! 3988 2019-05-22 11:32:37Z kanani
    116119! Implement steerable output interval for virtual measurements
    117 ! 
     120!
    118121! 3968 2019-05-13 11:04:01Z suehring
    119122! replace nspec_out with n_matched_vars
    120 ! 
     123!
    121124! 3929 2019-04-24 12:52:08Z banzhafs
    122125! Reverse changes back from revision 3878: use chem_boundary_conds instead of
    123126! chem_boundary_conds_decycle
    124 ! 
    125 ! 
     127!
     128!
    126129! 3885 2019-04-11 11:29:34Z kanani
    127 ! Changes related to global restructuring of location messages and introduction 
     130! Changes related to global restructuring of location messages and introduction
    128131! of additional debug messages
    129132!
    130133! 3879 2019-04-08 20:25:23Z knoop
    131134! Moved wtm_forces to module_interface_actions
    132 ! 
     135!
    133136! 3872 2019-04-08 15:03:06Z knoop
    134137! Modifications made for salsa:
     
    136139!   salsa_emission_update (i.e. skip_time_do_salsa >= time_since_reference_point
    137140!   and next_aero_emission_update <= time_since_reference_point ).
    138 ! - Renamed nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and 
     141! - Renamed nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and
    139142!   ngast --> ngases_salsa and loop indices b, c and sg to ib, ic and ig
    140143! - Apply nesting for salsa variables
    141144! - Removed cpu_log calls speciffic for salsa.
    142 ! 
     145!
    143146! 3833 2019-03-28 15:04:04Z forkel
    144147! added USE chem_gasphase_mod, replaced nspec by nspec since fixed compounds are not integrated
    145 ! 
     148!
    146149! 3820 2019-03-27 11:53:41Z forkel
    147150! renamed do_emiss to emissions_anthropogenic (ecc)
    148 ! 
    149 ! 
     151!
     152!
    150153! 3774 2019-03-04 10:52:49Z moh.hefny
    151154! rephrase if statement to avoid unallocated array in case of
     
    155158! module section re-formatted and openacc required variables moved to separate section,
    156159! re-formatting to 100 char line width
    157 ! 
     160!
    158161! 3745 2019-02-15 18:57:56Z suehring
    159162! Call indoor model after first timestep
    160 ! 
     163!
    161164! 3744 2019-02-15 18:38:58Z suehring
    162165! - Moved call of bio_calculate_thermal_index_maps from biometeorology module to
    163166! time_integration to make sure averaged input is updated before calculating.
    164 ! 
     167!
    165168! 3739 2019-02-13 08:05:17Z dom_dwd_user
    166169! Removed everything related to "time_bio_results" as this is never used.
    167 ! 
     170!
    168171! 3724 2019-02-06 16:28:23Z kanani
    169 ! Correct double-used log_point_s unit 
    170 ! 
     172! Correct double-used log_point_s unit
     173!
    171174! 3719 2019-02-06 13:10:18Z kanani
    172175! - removed wind_turbine cpu measurement, since same time is measured inside
     
    176179!   moved radiation_interactions cpulog to special measures
    177180! - moved some cpu_log calls to this routine for better overview
    178 ! 
     181!
    179182! 3705 2019-01-29 19:56:39Z suehring
    180183! Data output for virtual measurements added
    181 ! 
     184!
    182185! 3704 2019-01-29 19:51:41Z suehring
    183186! Rename subroutines for surface-data output
    184 ! 
     187!
    185188! 3647 2019-01-02 14:10:44Z kanani
    186189! Bugfix: add time_since_reference_point to IF clause for data_output calls
     
    198201!------------------------------------------------------------------------------!
    199202 SUBROUTINE time_integration
    200  
     203
    201204
    202205    USE advec_ws,                                                                                  &
     
    400403               vm_time_start
    401404
    402                
     405
    403406    USE wind_turbine_model_mod,                                                                    &
    404407        ONLY:  dt_data_output_wtm, time_wtm, wind_turbine, wtm_data_output
     
    406409#if defined( _OPENACC )
    407410    USE arrays_3d,                                                                                 &
    408         ONLY:  d, dd2zu, ddzu, ddzw, drho_air, drho_air_zw, dzw, e, heatflux_output_conversion,    &
     411        ONLY:  d, dd2zu, ddzu, ddzw,                                                               &
     412               diss_l_u,                                                                           &
     413               diss_l_v,                                                                           &
     414               diss_l_w,                                                                           &
     415               diss_s_u,                                                                           &
     416               diss_s_v,                                                                           &
     417               diss_s_w,                                                                           &
     418               drho_air, drho_air_zw, dzw, e,                                                      &
     419               flux_l_u,                                                                           &
     420               flux_l_v,                                                                           &
     421               flux_l_w,                                                                           &
     422               flux_s_u,                                                                           &
     423               flux_s_v,                                                                           &
     424               flux_s_w,                                                                           &
     425               heatflux_output_conversion,                                                         &
    409426               kh, km, momentumflux_output_conversion, nc, nr, p, ptdf_x, ptdf_y, qc, qr, rdf,     &
    410427               rdf_sc, rho_air, rho_air_zw, s, tdiss_m, te_m, tpt_m, tu_m, tv_m, tw_m, ug, u_init, &
     
    453470!
    454471!-- Copy data from arrays_3d
    455 !$ACC DATA & 
     472!$ACC DATA &
    456473!$ACC COPY(d(nzb+1:nzt,nys:nyn,nxl:nxr)) &
    457474!$ACC COPY(diss(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
     
    466483
    467484!$ACC DATA &
     485!$ACC COPYIN(diss_l_u(0:nz+1,nys:nyn,0), flux_l_u(0:nz+1,nys:nyn,0)) &
     486!$ACC COPYIN(diss_l_v(0:nz+1,nys:nyn,0), flux_l_v(0:nz+1,nys:nyn,0)) &
     487!$ACC COPYIN(diss_l_w(0:nz+1,nys:nyn,0), flux_l_w(0:nz+1,nys:nyn,0)) &
     488!$ACC COPYIN(diss_s_u(0:nz+1,0), flux_s_u(0:nz+1,0)) &
     489!$ACC COPYIN(diss_s_v(0:nz+1,0), flux_s_v(0:nz+1,0)) &
     490!$ACC COPYIN(diss_s_w(0:nz+1,0), flux_s_w(0:nz+1,0)) &
    468491!$ACC COPY(diss_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
    469492!$ACC COPY(e_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
     
    569592    CALL run_control
    570593!
    571 !-- Data exchange between coupled models in case that a call has been omitted 
     594!-- Data exchange between coupled models in case that a call has been omitted
    572595!-- at the end of the previous run of a job chain.
    573596    IF ( coupling_mode /= 'uncoupled'  .AND.  run_coupled  .AND. .NOT. vnested )  THEN
    574597!
    575 !--    In case of model termination initiated by the local model the coupler 
    576 !--    must not be called because this would again cause an MPI hang. 
     598!--    In case of model termination initiated by the local model the coupler
     599!--    must not be called because this would again cause an MPI hang.
    577600       DO WHILE ( time_coupling >= dt_coupling  .AND.  terminate_coupled == 0 )
    578601          CALL surface_coupler
     
    606629
    607630!
    608 !--    Determine ug, vg and w_subs in dependence on data from external file 
     631!--    Determine ug, vg and w_subs in dependence on data from external file
    609632!--    LSF_DATA
    610633       IF ( large_scale_forcing .AND. lsf_vert )  THEN
     
    614637
    615638!
    616 !--    Set pt_init and q_init to the current profiles taken from 
    617 !--    NUDGING_DATA 
     639!--    Set pt_init and q_init to the current profiles taken from
     640!--    NUDGING_DATA
    618641       IF ( nudging )  THEN
    619642           CALL nudge_ref ( simulated_time )
     
    649672       ENDIF
    650673!
    651 !--    Input of boundary data. 
     674!--    Input of boundary data.
    652675       IF ( nesting_offline )  CALL nesting_offl_input
    653676!
    654677!--    Execute all other module actions routines
    655678       CALL module_interface_actions( 'before_timestep' )
    656        
     679
    657680!--    Start of intermediate step loop
    658681       intermediate_timestep_count = 0
     
    689712!
    690713!--          Assure that ref_state does not become zero at any level
    691 !--          ( might be the case if a vertical level is completely occupied 
     714!--          ( might be the case if a vertical level is completely occupied
    692715!--            with topography ).
    693716             ref_state = MERGE( MAXVAL(ref_state), ref_state, ref_state == 0.0_wp )
     
    856879                ENDIF
    857880
    858                 IF ( passive_scalar )  CALL exchange_horiz( s, nbgp ) 
     881                IF ( passive_scalar )  CALL exchange_horiz( s, nbgp )
    859882
    860883                IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e, nbgp )
     
    866889                IF ( air_chemistry )  THEN
    867890                   DO  n = 1, nvar
    868                       CALL exchange_horiz( chem_species(n)%conc, nbgp ) 
     891                      CALL exchange_horiz( chem_species(n)%conc, nbgp )
    869892                   ENDDO
    870893                ENDIF
     
    973996
    974997!
    975 !--       Map forcing data derived from larger scale model onto domain 
     998!--       Map forcing data derived from larger scale model onto domain
    976999!--       boundaries. Further, update geostrophic wind components.
    9771000          IF ( nesting_offline  .AND.  intermediate_timestep_count ==                              &
    9781001                                       intermediate_timestep_count_max  )  THEN
    979 !--          Determine interpolation factor before boundary conditions and geostrophic wind 
     1002!--          Determine interpolation factor before boundary conditions and geostrophic wind
    9801003!--          is updated.
    9811004             CALL nesting_offl_interpolation_factor
     
    9941017!--       Ensure mass conservation. This need to be done after imposing
    9951018!--       synthetic turbulence and top boundary condition for pressure is set to
    996 !--       Neumann conditions. 
     1019!--       Neumann conditions.
    9971020!--       Is this also required in case of Dirichlet?
    9981021          IF ( nesting_offline )  CALL nesting_offl_mass_conservation
     
    10131036                CALL vnest_boundary_conds
    10141037                CALL cpu_log( log_point_s(30), 'vnest_bc', 'stop' )
    1015  
     1038
    10161039                IF ( coupling_mode == 'vnested_fine' )  CALL pres
    10171040
     
    10581081          ENDIF
    10591082!
    1060 !--       If required, compute virtual potential temperature 
    1061           IF ( humidity )  THEN 
    1062              CALL compute_vpt 
    1063           ENDIF 
     1083!--       If required, compute virtual potential temperature
     1084          IF ( humidity )  THEN
     1085             CALL compute_vpt
     1086          ENDIF
    10641087
    10651088!
     
    10681091
    10691092!
    1070 !--          Determine surface fluxes shf and qsws and surface values 
    1071 !--          pt_surface and q_surface in dependence on data from external 
     1093!--          Determine surface fluxes shf and qsws and surface values
     1094!--          pt_surface and q_surface in dependence on data from external
    10721095!--          file LSF_DATA respectively
    10731096             IF ( ( large_scale_forcing .AND. lsf_surf ) .AND.                                     &
     
    10781101
    10791102!
    1080 !--          First the vertical (and horizontal) fluxes in the surface 
     1103!--          First the vertical (and horizontal) fluxes in the surface
    10811104!--          (constant flux) layer are computed
    10821105             IF ( constant_flux_layer )  THEN
     
    10861109             ENDIF
    10871110!
    1088 !--          If required, solve the energy balance for the surface and run soil 
     1111!--          If required, solve the energy balance for the surface and run soil
    10891112!--          model. Call for horizontal as well as vertical surfaces
    10901113             IF ( land_surface .AND. time_since_reference_point >= skip_time_do_lsm)  THEN
     
    11141137!
    11151138!--             At the end, set boundary conditons for potential temperature
    1116 !--             and humidity after running the land-surface model. This 
     1139!--             and humidity after running the land-surface model. This
    11171140!--             might be important for the nesting, where arrays are transfered.
    11181141                CALL lsm_boundary_condition
     
    11221145             ENDIF
    11231146!
    1124 !--          If required, solve the energy balance for urban surfaces and run 
     1147!--          If required, solve the energy balance for urban surfaces and run
    11251148!--          the material heat model
    11261149             IF (urban_surface) THEN
     
    11351158!
    11361159!--             At the end, set boundary conditons for potential temperature
    1137 !--             and humidity after running the urban-surface model. This 
     1160!--             and humidity after running the urban-surface model. This
    11381161!--             might be important for the nesting, where arrays are transfered.
    11391162                CALL usm_boundary_condition
     
    12001223!
    12011224!--          Adjust the current time to the time step of the radiation model.
    1202 !--          Needed since radiation is pre-calculated and stored only on apparent 
     1225!--          Needed since radiation is pre-calculated and stored only on apparent
    12031226!--          solar positions
    12041227             time_since_reference_point_save = time_since_reference_point
     
    12131236                CALL cpu_log( log_point_s(46), 'radiation_interaction', 'stop' )
    12141237             ENDIF
    1215  
     1238
    12161239!
    12171240!--          Return the current time to its original value
     
    12231246       ENDIF
    12241247
    1225        
     1248
    12261249!
    12271250!-- 20200203 (ECC)
     
    12711294!--    dt_indoor steers the frequency of the indoor model calculations.
    12721295!--    Note, at first timestep indoor model is called, in order to provide
    1273 !--    a waste heat flux. 
     1296!--    a waste heat flux.
    12741297       IF ( indoor_model )  THEN
    12751298
     
    13421365          time_virtual_measurement = time_virtual_measurement + dt_3d
    13431366       ENDIF
    1344        
     1367
    13451368!
    13461369!--    Increment time-counter for wind turbine data output
     
    13481371          time_wtm = time_wtm + dt_3d
    13491372       ENDIF
    1350  
     1373
    13511374!
    13521375!--    In case of synthetic turbulence generation and parametrized turbulence
    1353 !--    information, update the time counter and if required, adjust the 
     1376!--    information, update the time counter and if required, adjust the
    13541377!--    STG to new atmospheric conditions.
    13551378       IF ( use_syn_turb_gen  )  THEN
     
    13711394
    13721395!
    1373 !--       In case of model termination initiated by the local model 
    1374 !--       (terminate_coupled > 0), the coupler must be skipped because it would 
     1396!--       In case of model termination initiated by the local model
     1397!--       (terminate_coupled > 0), the coupler must be skipped because it would
    13751398!--       cause an MPI intercomminucation hang.
    1376 !--       If necessary, the coupler will be called at the beginning of the 
     1399!--       If necessary, the coupler will be called at the beginning of the
    13771400!--       next restart run.
    13781401          DO WHILE ( time_coupling >= dt_coupling  .AND.  terminate_coupled == 0 )
     
    14691492                .AND.  ( dt_dosurf_av - time_dosurf_av ) <= averaging_interval_surf                &
    14701493                .AND.  time_since_reference_point >= skip_time_dosurf_av )  THEN
    1471              IF ( time_dosurf_av >= dt_averaging_input )  THEN       
     1494             IF ( time_dosurf_av >= dt_averaging_input )  THEN
    14721495                CALL surface_data_output_averaging
    14731496                average_count_surf = average_count_surf + 1
     
    15021525                                          MAX( dt_virtual_measurement, dt_3d ) )
    15031526       ENDIF
    1504        
     1527
    15051528!
    15061529!--    Output wind turbine data
     
    15091532          time_wtm = MOD( time_wtm, MAX( dt_data_output_wtm, dt_3d ) )
    15101533       ENDIF
    1511        
     1534
    15121535!
    15131536!--    Profile output (ASCII) on file
     
    17071730#if defined( __parallel )
    17081731!
    1709 !-- Vertical nesting: Deallocate variables initialized for vertical nesting   
     1732!-- Vertical nesting: Deallocate variables initialized for vertical nesting
    17101733    IF ( vnest_init )  CALL vnest_deallocate
    17111734#endif
Note: See TracChangeset for help on using the changeset viewer.