Index: /palm/trunk/SOURCE/Makefile
===================================================================
--- /palm/trunk/SOURCE/Makefile	(revision 1872)
+++ /palm/trunk/SOURCE/Makefile	(revision 1873)
@@ -270,18 +270,18 @@
 PROG =  palm
 
-SOURCES = advec_s_bc_mod.f90 advec_s_pw_mod.f90 advec_s_up_mod.f90 advec_ws_mod.f90 \
-	advec_u_pw_mod.f90 advec_u_up_mod.f90 advec_v_pw_mod.f90 advec_v_up_mod.f90 \
-	advec_w_pw_mod.f90 advec_w_up_mod.f90 average_3d_data.f90 boundary_conds.f90 \
-	buoyancy_mod.f90 calc_liquid_water_content.f90 calc_mean_profile_mod.f90 \
-	calc_radiation_mod.f90 \
+SOURCES = advec_s_bc.f90 advec_s_pw.f90 advec_s_up.f90 advec_ws.f90 \
+	advec_u_pw.f90 advec_u_up.f90 advec_v_pw.f90 advec_v_up.f90 \
+	advec_w_pw.f90 advec_w_up.f90 average_3d_data.f90 boundary_conds.f90 \
+	buoyancy.f90 calc_liquid_water_content.f90 calc_mean_profile.f90 \
+	calc_radiation.f90 \
 	check_for_restart.f90 check_open.f90 check_parameters.f90 \
-	close_file.f90 compute_vpt.f90 coriolis_mod.f90 cpulog_mod.f90 \
-	cuda_fft_interfaces_mod.f90 data_log.f90 data_output_dvrp_mod.f90 \
+	close_file.f90 compute_vpt.f90 coriolis.f90 cpulog_mod.f90 \
+	cuda_fft_interfaces_mod.f90 data_log.f90 data_output_dvrp.f90 \
 	data_output_mask.f90 data_output_profiles.f90 \
 	data_output_ptseries.f90 data_output_spectra.f90 \
 	data_output_tseries.f90 data_output_2d.f90 data_output_3d.f90 \
-	diffusion_e_mod.f90 diffusion_s_mod.f90 diffusion_u_mod.f90 diffusion_v_mod.f90 \
-	diffusion_w_mod.f90 diffusivities.f90 disturb_field.f90 \
-	disturb_heatflux.f90 eqn_state_seawater_mod.f90 exchange_horiz.f90 \
+	diffusion_e.f90 diffusion_s.f90 diffusion_u.f90 diffusion_v.f90 \
+	diffusion_w.f90 diffusivities.f90 disturb_field.f90 \
+	disturb_heatflux.f90 eqn_state_seawater.f90 exchange_horiz.f90 \
 	exchange_horiz_2d.f90 fft_xy_mod.f90 flow_statistics.f90 \
 	global_min_max.f90 header.f90 \
@@ -290,11 +290,11 @@
 	init_grid.f90 init_masks.f90 init_ocean.f90 \
 	init_pegrid.f90 init_pt_anomaly.f90 init_rankine.f90 init_slope.f90 \
-	interaction_droplets_ptq_mod.f90 land_surface_model_mod.f90 \
+	interaction_droplets_ptq.f90 land_surface_model_mod.f90 \
 	local_stop.f90 local_system.f90 local_tremain.f90 \
 	local_tremain_ini.f90 lpm.f90 lpm_advec.f90 lpm_boundary_conds.f90 \
-	lpm_calc_liquid_water_content.f90 lpm_collision_kernels_mod.f90 \
+	lpm_calc_liquid_water_content.f90 lpm_collision_kernels.f90 \
 	lpm_data_output_particles.f90 lpm_droplet_collision.f90 \
-	lpm_droplet_condensation.f90 lpm_exchange_horiz_mod.f90 \
-	lpm_init_mod.f90 lpm_init_sgs_tke.f90 \
+	lpm_droplet_condensation.f90 lpm_exchange_horiz.f90 \
+	lpm_init.f90 lpm_init_sgs_tke.f90 \
 	lpm_pack_arrays.f90 lpm_read_restart_file.f90 \
 	lpm_set_attributes.f90 \
@@ -306,6 +306,6 @@
 	pmc_server_mod.f90 \
 	poisfft_mod.f90 poismg.f90 \
-	poismg_fast_mod.f90 pres.f90 print_1d.f90 production_e_mod.f90 \
-	prognostic_equations_mod.f90 progress_bar_mod.f90 radiation_model_mod.f90 \
+	poismg_fast_mod.f90 pres.f90 print_1d.f90 production_e.f90 \
+	prognostic_equations.f90 progress_bar_mod.f90 radiation_model_mod.f90 \
 	random_function_mod.f90 random_gauss.f90 random_generator_parallel_mod.f90 \
 	read_3d_binary.f90 read_var_list.f90 run_control.f90 \
@@ -316,5 +316,5 @@
 	timestep_scheme_steering.f90 transpose.f90 tridia_solver_mod.f90 \
 	user_3d_data_averaging.f90 \
-	user_actions_mod.f90 user_additional_routines.f90 \
+	user_actions.f90 user_additional_routines.f90 \
 	user_check_data_output.f90 user_check_data_output_pr.f90 \
 	user_check_parameters.f90 user_data_output_2d.f90 \
@@ -325,7 +325,7 @@
 	user_init_plant_canopy.f90 user_init_radiation.f90 \
 	user_last_actions.f90 user_lpm_advec.f90 \
-	user_lpm_init.f90 user_lpm_set_attributes.f90 user_module_mod.f90 \
+	user_lpm_init.f90 user_lpm_set_attributes.f90 user_module.f90 \
 	user_parin.f90 user_read_restart_data.f90 \
-	user_spectra.f90 user_statistics.f90 wall_fluxes_mod.f90 \
+	user_spectra.f90 user_statistics.f90 wall_fluxes.f90 \
 	write_3d_binary.f90 write_var_list.f90
 
@@ -360,21 +360,21 @@
 
 
-advec_s_bc_mod.o: modules.o cpulog_mod.o mod_kinds.o
-advec_s_pw_mod.o: modules.o mod_kinds.o
-advec_s_up_mod.o: modules.o mod_kinds.o
-advec_u_pw_mod.o: modules.o mod_kinds.o
-advec_u_up_mod.o: modules.o mod_kinds.o
-advec_v_pw_mod.o: modules.o mod_kinds.o
-advec_v_up_mod.o: modules.o mod_kinds.o
-advec_ws_mod.o: modules.o mod_kinds.o
-advec_w_pw_mod.o: modules.o mod_kinds.o
-advec_w_up_mod.o: modules.o mod_kinds.o
+advec_s_bc.o: modules.o cpulog_mod.o mod_kinds.o
+advec_s_pw.o: modules.o mod_kinds.o
+advec_s_up.o: modules.o mod_kinds.o
+advec_u_pw.o: modules.o mod_kinds.o
+advec_u_up.o: modules.o mod_kinds.o
+advec_v_pw.o: modules.o mod_kinds.o
+advec_v_up.o: modules.o mod_kinds.o
+advec_ws.o: modules.o mod_kinds.o
+advec_w_pw.o: modules.o mod_kinds.o
+advec_w_up.o: modules.o mod_kinds.o
 average_3d_data.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o\
                    radiation_model_mod.o
 boundary_conds.o: modules.o mod_kinds.o
-buoyancy_mod.o: modules.o mod_kinds.o
-calc_mean_profile_mod.o: modules.o mod_kinds.o
+buoyancy.o: modules.o mod_kinds.o
+calc_mean_profile.o: modules.o mod_kinds.o
 calc_liquid_water_content.o: modules.o mod_kinds.o
-calc_radiation_mod.o: modules.o mod_kinds.o
+calc_radiation.o: modules.o mod_kinds.o
 check_for_restart.o: modules.o mod_kinds.o pmc_interface_mod.o
 check_open.o: modules.o mod_kinds.o mod_particle_attributes.o netcdf_interface_mod.o
@@ -384,10 +384,10 @@
 close_file.o: modules.o mod_kinds.o netcdf_interface_mod.o
 compute_vpt.o: modules.o mod_kinds.o
-coriolis_mod.o: modules.o mod_kinds.o
+coriolis.o: modules.o mod_kinds.o
 cpulog_mod.o: modules.o mod_kinds.o
 cpu_statistics.o: modules.o mod_kinds.o
 cuda_fft_interfaces_mod.o: cuda_fft_interfaces_mod.f90 modules.o mod_kinds.o
 data_log.o: modules.o mod_kinds.o
-data_output_dvrp_mod.o: modules.o cpulog_mod.o mod_kinds.o
+data_output_dvrp.o: modules.o cpulog_mod.o mod_kinds.o
 data_output_mask.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o \
    netcdf_interface_mod.o
@@ -402,15 +402,15 @@
 data_output_3d.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o\
    netcdf_interface_mod.o land_surface_model_mod.o
-diffusion_e_mod.o: modules.o mod_kinds.o microphysics_mod.o \
+diffusion_e.o: modules.o mod_kinds.o microphysics_mod.o \
    mod_particle_attributes.o
-diffusion_s_mod.o: modules.o mod_kinds.o
-diffusion_u_mod.o: modules.o mod_kinds.o wall_fluxes_mod.o
-diffusion_v_mod.o: modules.o mod_kinds.o wall_fluxes_mod.o
-diffusion_w_mod.o: modules.o mod_kinds.o wall_fluxes_mod.o
+diffusion_s.o: modules.o mod_kinds.o
+diffusion_u.o: modules.o mod_kinds.o wall_fluxes.o
+diffusion_v.o: modules.o mod_kinds.o wall_fluxes.o
+diffusion_w.o: modules.o mod_kinds.o wall_fluxes.o
 diffusivities.o: modules.o mod_kinds.o
 disturb_field.o: modules.o cpulog_mod.o mod_kinds.o random_function_mod.o\
                  random_generator_parallel_mod.o
 disturb_heatflux.o: modules.o cpulog_mod.o mod_kinds.o
-eqn_state_seawater_mod.o: modules.o mod_kinds.o
+eqn_state_seawater.o: modules.o mod_kinds.o
 exchange_horiz.o: modules.o cpulog_mod.o mod_kinds.o
 exchange_horiz_2d.o: modules.o cpulog_mod.o mod_kinds.o
@@ -424,6 +424,6 @@
 inflow_turbulence.o: modules.o cpulog_mod.o mod_kinds.o
 init_1d_model.o: modules.o mod_kinds.o
-init_3d_model.o: modules.o mod_kinds.o advec_ws_mod.o cpulog_mod.o land_surface_model_mod.o \
-   lpm_init_mod.o ls_forcing_mod.o netcdf_interface_mod.o plant_canopy_model_mod.o \
+init_3d_model.o: modules.o mod_kinds.o advec_ws.o cpulog_mod.o land_surface_model_mod.o \
+   lpm_init.o ls_forcing_mod.o netcdf_interface_mod.o plant_canopy_model_mod.o \
    radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \
    surface_layer_fluxes_mod.o microphysics_mod.o mod_particle_attributes.o
@@ -434,15 +434,15 @@
 init_grid.o: modules.o mod_kinds.o
 init_masks.o: modules.o mod_kinds.o netcdf_interface_mod.o
-init_ocean.o: modules.o eqn_state_seawater_mod.o mod_kinds.o
+init_ocean.o: modules.o eqn_state_seawater.o mod_kinds.o
 init_pegrid.o: modules.o mod_kinds.o spectra_mod.o
 init_pt_anomaly.o: modules.o mod_kinds.o
 init_rankine.o: modules.o mod_kinds.o
 init_slope.o: modules.o mod_kinds.o
-interaction_droplets_ptq_mod.o: modules.o mod_kinds.o
+interaction_droplets_ptq.o: modules.o mod_kinds.o
 land_surface_model_mod.o: modules.o mod_kinds.o radiation_model_mod.o
 local_stop.o: modules.o mod_kinds.o pmc_interface_mod.o
 local_tremain.o: modules.o cpulog_mod.o mod_kinds.o
 local_tremain_ini.o: modules.o cpulog_mod.o mod_kinds.o
-lpm.o: modules.o cpulog_mod.o lpm_exchange_horiz_mod.o lpm_init_mod.o lpm_pack_arrays.o \
+lpm.o: modules.o cpulog_mod.o lpm_exchange_horiz.o lpm_init.o lpm_pack_arrays.o \
 	mod_kinds.o mod_particle_attributes.o
 lpm_advec.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o
@@ -450,17 +450,17 @@
 lpm_calc_liquid_water_content.o: modules.o cpulog_mod.o mod_kinds.o \
 	mod_particle_attributes.o
-lpm_collision_kernels_mod.o: modules.o cpulog_mod.o user_module_mod.o mod_kinds.o \
+lpm_collision_kernels.o: modules.o cpulog_mod.o user_module.o mod_kinds.o \
 	mod_particle_attributes.o
 lpm_data_output_particles.o: modules.o cpulog_mod.o mod_kinds.o \
 	mod_particle_attributes.o netcdf_interface_mod.o
-lpm_droplet_collision.o: modules.o cpulog_mod.o lpm_collision_kernels_mod.o \
+lpm_droplet_collision.o: modules.o cpulog_mod.o lpm_collision_kernels.o \
 	mod_kinds.o mod_particle_attributes.o
-lpm_droplet_condensation.o: modules.o cpulog_mod.o lpm_collision_kernels_mod.o \
+lpm_droplet_condensation.o: modules.o cpulog_mod.o lpm_collision_kernels.o \
 	mod_kinds.o mod_particle_attributes.o
-lpm_exchange_horiz_mod.o: modules.o cpulog_mod.o lpm_pack_arrays.o mod_kinds.o \
+lpm_exchange_horiz.o: modules.o cpulog_mod.o lpm_pack_arrays.o mod_kinds.o \
 	mod_particle_attributes.o netcdf_interface_mod.o
-lpm_init_mod.o: modules.o lpm_collision_kernels_mod.o mod_kinds.o \
+lpm_init.o: modules.o lpm_collision_kernels.o mod_kinds.o \
 	netcdf_interface_mod.o random_function_mod.o mod_particle_attributes.o \
-	lpm_exchange_horiz_mod.o lpm_pack_arrays.o random_generator_parallel_mod.o
+	lpm_exchange_horiz.o lpm_pack_arrays.o random_generator_parallel_mod.o
 lpm_init_sgs_tke.o: modules.o mod_kinds.o mod_particle_attributes.o
 lpm_pack_arrays.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o
@@ -499,12 +499,12 @@
 pres.o: modules.o cpulog_mod.o mod_kinds.o poisfft_mod.o poismg_fast_mod.o
 print_1d.o: modules.o cpulog_mod.o mod_kinds.o
-production_e_mod.o: modules.o mod_kinds.o wall_fluxes_mod.o
-prognostic_equations_mod.o: modules.o advec_s_pw_mod.o advec_s_up_mod.o advec_s_bc_mod.o advec_u_pw_mod.o \
-	advec_u_up_mod.o advec_v_pw_mod.o advec_v_up_mod.o advec_w_pw_mod.o advec_w_up_mod.o \
-	advec_ws_mod.o buoyancy_mod.o calc_radiation_mod.o coriolis_mod.o \
-	cpulog_mod.o diffusion_e_mod.o diffusion_s_mod.o diffusion_u_mod.o diffusion_v_mod.o diffusion_w_mod.o \
-	eqn_state_seawater_mod.o mod_kinds.o microphysics_mod.o \
-	nudging_mod.o plant_canopy_model_mod.o production_e_mod.o radiation_model_mod.o \
-	subsidence_mod.o user_actions_mod.o
+production_e.o: modules.o mod_kinds.o wall_fluxes.o
+prognostic_equations.o: modules.o advec_s_pw.o advec_s_up.o advec_s_bc.o advec_u_pw.o \
+	advec_u_up.o advec_v_pw.o advec_v_up.o advec_w_pw.o advec_w_up.o \
+	advec_ws.o buoyancy.o calc_radiation.o coriolis.o \
+	cpulog_mod.o diffusion_e.o diffusion_s.o diffusion_u.o diffusion_v.o diffusion_w.o \
+	eqn_state_seawater.o mod_kinds.o microphysics_mod.o \
+	nudging_mod.o plant_canopy_model_mod.o production_e.o radiation_model_mod.o \
+	subsidence_mod.o user_actions.o
 progress_bar_mod.o: modules.o mod_kinds.o
 radiation_model_mod.o : modules.o mod_particle_attributes.o microphysics_mod.o
@@ -530,9 +530,9 @@
    pmc_interface_mod.o
 temperton_fft_mod.o: modules.o mod_kinds.o
-time_integration.o: modules.o advec_ws_mod.o buoyancy_mod.o calc_mean_profile_mod.o \
-	cpulog_mod.o interaction_droplets_ptq_mod.o land_surface_model_mod.o \
-	ls_forcing_mod.o mod_kinds.o nudging_mod.o pmc_interface_mod.o production_e_mod.o \
-	prognostic_equations_mod.o progress_bar_mod.o radiation_model_mod.o \
-	spectra_mod.o user_actions_mod.o surface_layer_fluxes_mod.o microphysics_mod.o
+time_integration.o: modules.o advec_ws.o buoyancy.o calc_mean_profile.o \
+	cpulog_mod.o interaction_droplets_ptq.o land_surface_model_mod.o \
+	ls_forcing_mod.o mod_kinds.o nudging_mod.o pmc_interface_mod.o production_e.o \
+	prognostic_equations.o progress_bar_mod.o radiation_model_mod.o \
+	spectra_mod.o user_actions.o surface_layer_fluxes_mod.o microphysics_mod.o
 time_to_string.o: mod_kinds.o
 timestep.o: modules.o cpulog_mod.o mod_kinds.o microphysics_mod.o
@@ -540,34 +540,34 @@
 transpose.o: modules.o cpulog_mod.o mod_kinds.o
 tridia_solver_mod.o: modules.o mod_kinds.o
-user_3d_data_averaging.o: modules.o mod_kinds.o user_module_mod.o
-user_actions_mod.o: modules.o cpulog_mod.o mod_kinds.o user_module_mod.o
-user_additional_routines.o: modules.o mod_kinds.o user_module_mod.o
-user_check_data_output.o: modules.o mod_kinds.o user_module_mod.o
-user_check_data_output_pr.o: modules.o mod_kinds.o user_module_mod.o \
+user_3d_data_averaging.o: modules.o mod_kinds.o user_module.o
+user_actions.o: modules.o cpulog_mod.o mod_kinds.o user_module.o
+user_additional_routines.o: modules.o mod_kinds.o user_module.o
+user_check_data_output.o: modules.o mod_kinds.o user_module.o
+user_check_data_output_pr.o: modules.o mod_kinds.o user_module.o \
    netcdf_interface_mod.o
-user_check_parameters.o: modules.o mod_kinds.o user_module_mod.o
-user_data_output_2d.o: modules.o mod_kinds.o user_module_mod.o
-user_data_output_3d.o: modules.o mod_kinds.o user_module_mod.o
-user_data_output_mask.o: modules.o mod_kinds.o user_module_mod.o
-user_data_output_dvrp.o: modules.o mod_kinds.o user_module_mod.o
-user_define_netcdf_grid.o: modules.o mod_kinds.o user_module_mod.o
-user_dvrp_coltab.o: modules.o mod_kinds.o user_module_mod.o
-user_header.o: modules.o mod_kinds.o user_module_mod.o
-user_init.o: modules.o mod_kinds.o netcdf_interface_mod.o user_module_mod.o
-user_init_3d_model.o: modules.o mod_kinds.o user_module_mod.o
-user_init_grid.o: modules.o mod_kinds.o user_module_mod.o
-user_init_land_surface.o: modules.o mod_kinds.o user_module_mod.o land_surface_model_mod.o
-user_init_plant_canopy.o: modules.o mod_kinds.o user_module_mod.o plant_canopy_model_mod.o
-user_init_radiation.o: modules.o mod_kinds.o user_module_mod.o radiation_model_mod.o
-user_last_actions.o: modules.o mod_kinds.o user_module_mod.o
-user_lpm_advec.o: modules.o mod_kinds.o user_module_mod.o
-user_lpm_init.o: modules.o mod_kinds.o user_module_mod.o
-user_lpm_set_attributes.o: modules.o mod_kinds.o user_module_mod.o
-user_module_mod.o: mod_kinds.o user_module_mod.f90
-user_parin.o: modules.o mod_kinds.o user_module_mod.o
-user_read_restart_data.o: modules.o mod_kinds.o user_module_mod.o
-user_spectra.o: modules.o mod_kinds.o spectra_mod.o user_module_mod.o
-user_statistics.o: modules.o mod_kinds.o netcdf_interface_mod.o user_module_mod.o
-wall_fluxes_mod.o: modules.o mod_kinds.o
+user_check_parameters.o: modules.o mod_kinds.o user_module.o
+user_data_output_2d.o: modules.o mod_kinds.o user_module.o
+user_data_output_3d.o: modules.o mod_kinds.o user_module.o
+user_data_output_mask.o: modules.o mod_kinds.o user_module.o
+user_data_output_dvrp.o: modules.o mod_kinds.o user_module.o
+user_define_netcdf_grid.o: modules.o mod_kinds.o user_module.o
+user_dvrp_coltab.o: modules.o mod_kinds.o user_module.o
+user_header.o: modules.o mod_kinds.o user_module.o
+user_init.o: modules.o mod_kinds.o netcdf_interface_mod.o user_module.o
+user_init_3d_model.o: modules.o mod_kinds.o user_module.o
+user_init_grid.o: modules.o mod_kinds.o user_module.o
+user_init_land_surface.o: modules.o mod_kinds.o user_module.o land_surface_model_mod.o
+user_init_plant_canopy.o: modules.o mod_kinds.o user_module.o plant_canopy_model_mod.o
+user_init_radiation.o: modules.o mod_kinds.o user_module.o radiation_model_mod.o
+user_last_actions.o: modules.o mod_kinds.o user_module.o
+user_lpm_advec.o: modules.o mod_kinds.o user_module.o
+user_lpm_init.o: modules.o mod_kinds.o user_module.o
+user_lpm_set_attributes.o: modules.o mod_kinds.o user_module.o
+user_module.o: mod_kinds.o user_module.f90
+user_parin.o: modules.o mod_kinds.o user_module.o
+user_read_restart_data.o: modules.o mod_kinds.o user_module.o
+user_spectra.o: modules.o mod_kinds.o spectra_mod.o user_module.o
+user_statistics.o: modules.o mod_kinds.o netcdf_interface_mod.o user_module.o
+wall_fluxes.o: modules.o mod_kinds.o
 write_3d_binary.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \
 	radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \
Index: /palm/trunk/SOURCE/advec_s_bc.f90
===================================================================
--- /palm/trunk/SOURCE/advec_s_bc.f90	(revision 1873)
+++ /palm/trunk/SOURCE/advec_s_bc.f90	(revision 1873)
@@ -0,0 +1,1328 @@
+!> @file advec_s_bc.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+!
+! 1815 2016-04-06 13:49:59Z raasch
+! comment change
+!
+! 1691 2015-10-26 16:17:44Z maronga
+! Formatting corrections
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable
+! 
+! 1517 2015-01-07 19:12:25Z hoffmann
+! interface added to advec_s_bc
+!
+! 1374 2014-04-25 12:55:07Z raasch
+! missing variables added to ONLY list
+! 
+! 1361 2014-04-16 15:17:48Z hoffmann
+! nr and qr added
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1346 2014-03-27 13:18:20Z heinze
+! Bugfix: REAL constants provided with KIND-attribute especially in call of 
+! intrinsic function like MAX, MIN, SIGN
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1318 2014-03-17 13:35:16Z raasch
+! module interfaces removed
+!
+! 1092 2013-02-02 11:24:22Z raasch
+! unused variables removed
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1010 2012-09-20 07:59:54Z raasch
+! cpp switch __nopointer added for pointer free version
+!
+! Revision 1.1  1997/08/29 08:53:46  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Advection term for scalar quantities using the Bott-Chlond scheme.
+!> Computation in individual steps for each of the three dimensions.
+!> Limiting assumptions:
+!> So far the scheme has been assuming equidistant grid spacing. As this is not
+!> the case in the stretched portion of the z-direction, there dzw(k) is used as
+!> a substitute for a constant grid length. This certainly causes incorrect
+!> results; however, it is hoped that they are not too apparent for weakly 
+!> stretched grids.
+!> NOTE: This is a provisional, non-optimised version!
+!------------------------------------------------------------------------------!
+MODULE advec_s_bc_mod
+ 
+
+    PRIVATE
+    PUBLIC advec_s_bc
+
+    INTERFACE advec_s_bc
+       MODULE PROCEDURE advec_s_bc
+    END INTERFACE advec_s_bc
+
+ CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> @todo Missing subroutine description.
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_s_bc( sk, sk_char )
+
+       USE advection,                                                             &
+           ONLY:  aex, bex, dex, eex
+
+       USE arrays_3d,                                                             &
+           ONLY:  d, ddzw, dzu, dzw, tend, u, v, w
+
+       USE control_parameters,                                                    &
+           ONLY:  dt_3d, bc_pt_t_val, bc_q_t_val, ibc_pt_b, ibc_pt_t, ibc_q_t,    &
+                  message_string, pt_slope_offset, sloping_surface, u_gtrans,     &
+                  v_gtrans
+
+       USE cpulog,                                                                &
+           ONLY:  cpu_log, log_point_s
+
+       USE grid_variables,                                                        &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                               &
+           ONLY:  nx, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
+
+       USE kinds
+
+       USE pegrid
+
+       USE statistics,                                                            &
+           ONLY:  rmask, statistic_regions, sums_wsts_bc_l
+
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  sk_char !<
+
+       INTEGER(iwp) ::  i         !<
+       INTEGER(iwp) ::  ix        !<
+       INTEGER(iwp) ::  j         !<
+       INTEGER(iwp) ::  k         !<
+       INTEGER(iwp) ::  ngp       !<
+       INTEGER(iwp) ::  sr        !<
+       INTEGER(iwp) ::  type_xz_2 !<
+
+       REAL(wp) ::  cim    !<
+       REAL(wp) ::  cimf   !<
+       REAL(wp) ::  cip    !<
+       REAL(wp) ::  cipf   !<
+       REAL(wp) ::  d_new  !<
+       REAL(wp) ::  denomi !< denominator
+       REAL(wp) ::  fminus !<
+       REAL(wp) ::  fplus  !<
+       REAL(wp) ::  f2     !<
+       REAL(wp) ::  f4     !<
+       REAL(wp) ::  f8     !<
+       REAL(wp) ::  f12    !<
+       REAL(wp) ::  f24    !<
+       REAL(wp) ::  f48    !<
+       REAL(wp) ::  f1920  !<
+       REAL(wp) ::  im     !<
+       REAL(wp) ::  ip     !<
+       REAL(wp) ::  m2     !<
+       REAL(wp) ::  m3     !<
+       REAL(wp) ::  numera !< numerator
+       REAL(wp) ::  snenn  !<
+       REAL(wp) ::  sterm  !<
+       REAL(wp) ::  tendcy !<
+       REAL(wp) ::  t1     !<
+       REAL(wp) ::  t2     !<
+
+       REAL(wp) ::  fmax(2)   !<
+       REAL(wp) ::  fmax_l(2) !<
+       
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
+#endif
+
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a0   !<
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a1   !<
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a12  !<
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a2   !<
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a22  !<
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  immb !<
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  imme !<
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  impb !<
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  impe !<
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ipmb !<
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ipme !<
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ippb !<
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ippe !<
+       
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  sk_p !<
+
+#if defined( __nec )
+       REAL(sp) ::  m1n, m1z  !< important for optimisation of division
+       REAL(sp), DIMENSION(:,:), ALLOCATABLE :: m1, sw !<
+#else
+       REAL(wp) ::  m1n, m1z 
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m1, sw
+#endif
+
+
+!
+!--    Array sk_p requires 2 extra elements for each dimension
+       ALLOCATE( sk_p(nzb-2:nzt+3,nys-3:nyn+3,nxl-3:nxr+3) )
+       sk_p = 0.0_wp
+
+!
+!--    Assign reciprocal values in order to avoid divisions later
+       f2    = 0.5_wp
+       f4    = 0.25_wp
+       f8    = 0.125_wp
+       f12   = 0.8333333333333333E-01_wp
+       f24   = 0.4166666666666666E-01_wp
+       f48   = 0.2083333333333333E-01_wp
+       f1920 = 0.5208333333333333E-03_wp
+
+!
+!--    Advection in x-direction:
+
+!
+!--    Save the quantity to be advected in a local array
+!--    add an enlarged boundary in x-direction
+       DO  i = nxl-1, nxr+1
+          DO  j = nys, nyn
+             DO  k = nzb, nzt+1
+                sk_p(k,j,i) = sk(k,j,i)
+             ENDDO
+          ENDDO
+       ENDDO
+#if defined( __parallel )
+       ngp = 2 * ( nzt - nzb + 6 ) * ( nyn - nys + 7 )
+       CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'start' )
+!
+!--    Send left boundary, receive right boundary
+       CALL MPI_SENDRECV( sk_p(nzb-2,nys-3,nxl+1), ngp, MPI_REAL, pleft,  0,      &
+                          sk_p(nzb-2,nys-3,nxr+2), ngp, MPI_REAL, pright, 0,      &
+                          comm2d, status, ierr )
+!
+!--    Send right boundary, receive left boundary
+       CALL MPI_SENDRECV( sk_p(nzb-2,nys-3,nxr-2), ngp, MPI_REAL, pright, 1,      &
+                          sk_p(nzb-2,nys-3,nxl-3), ngp, MPI_REAL, pleft,  1,      &
+                          comm2d, status, ierr )
+       CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'pause' )
+#else
+
+!
+!--    Cyclic boundary conditions
+       sk_p(:,nys:nyn,nxl-3) = sk_p(:,nys:nyn,nxr-2)
+       sk_p(:,nys:nyn,nxl-2) = sk_p(:,nys:nyn,nxr-1)
+       sk_p(:,nys:nyn,nxr+2) = sk_p(:,nys:nyn,nxl+1)
+       sk_p(:,nys:nyn,nxr+3) = sk_p(:,nys:nyn,nxl+2)
+#endif
+
+!
+!--    In case of a sloping surface, the additional gridpoints in x-direction
+!--    of the temperature field at the left and right boundary of the total
+!--    domain must be adjusted by the temperature difference between this distance
+       IF ( sloping_surface  .AND.  sk_char == 'pt' )  THEN
+          IF ( nxl ==  0 )  THEN
+             sk_p(:,nys:nyn,nxl-3) = sk_p(:,nys:nyn,nxl-3) - pt_slope_offset
+             sk_p(:,nys:nyn,nxl-2) = sk_p(:,nys:nyn,nxl-2) - pt_slope_offset
+          ENDIF
+          IF ( nxr == nx )  THEN
+             sk_p(:,nys:nyn,nxr+2) = sk_p(:,nys:nyn,nxr+2) + pt_slope_offset
+             sk_p(:,nys:nyn,nxr+3) = sk_p(:,nys:nyn,nxr+3) + pt_slope_offset
+          ENDIF
+       ENDIF
+
+!
+!--    Initialise control density
+       d = 0.0_wp
+
+!
+!--    Determine maxima of the first and second derivative in x-direction
+       fmax_l = 0.0_wp
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                numera = ABS( sk_p(k,j,i+1) - 2.0_wp * sk_p(k,j,i) + sk_p(k,j,i-1) )
+                denomi  = ABS( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
+                fmax_l(1) = MAX( fmax_l(1) , numera )
+                fmax_l(2) = MAX( fmax_l(2) , denomi  )
+             ENDDO
+          ENDDO
+       ENDDO
+#if defined( __parallel )
+       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
+       CALL MPI_ALLREDUCE( fmax_l, fmax, 2, MPI_REAL, MPI_MAX, comm2d, ierr )
+#else
+       fmax = fmax_l
+#endif
+
+       fmax = 0.04_wp * fmax
+
+!
+!--    Allocate temporary arrays
+       ALLOCATE( a0(nzb+1:nzt,nxl-1:nxr+1),   a1(nzb+1:nzt,nxl-1:nxr+1),          &
+                 a2(nzb+1:nzt,nxl-1:nxr+1),   a12(nzb+1:nzt,nxl-1:nxr+1),         &
+                 a22(nzb+1:nzt,nxl-1:nxr+1),  immb(nzb+1:nzt,nxl-1:nxr+1),        &
+                 imme(nzb+1:nzt,nxl-1:nxr+1), impb(nzb+1:nzt,nxl-1:nxr+1),        &
+                 impe(nzb+1:nzt,nxl-1:nxr+1), ipmb(nzb+1:nzt,nxl-1:nxr+1),        &
+                 ipme(nzb+1:nzt,nxl-1:nxr+1), ippb(nzb+1:nzt,nxl-1:nxr+1),        &
+                 ippe(nzb+1:nzt,nxl-1:nxr+1), m1(nzb+1:nzt,nxl-2:nxr+2),          &
+                 sw(nzb+1:nzt,nxl-1:nxr+1)                                        &
+               )
+       imme = 0.0_wp; impe = 0.0_wp; ipme = 0.0_wp; ippe = 0.0_wp
+
+!
+!--    Initialise point of time measuring of the exponential portion (this would
+!--    not work if done locally within the loop)
+       CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'start' )
+       CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'pause' )
+
+!
+!--    Outer loop of all j
+       DO  j = nys, nyn
+
+!
+!--       Compute polynomial coefficients
+          DO  i = nxl-1, nxr+1
+             DO  k = nzb+1, nzt
+                a12(k,i) = 0.5_wp * ( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
+                a22(k,i) = 0.5_wp * ( sk_p(k,j,i+1) - 2.0_wp * sk_p(k,j,i)        &
+                                                    + sk_p(k,j,i-1) )
+                a0(k,i) = ( 9.0_wp * sk_p(k,j,i+2)    - 116.0_wp * sk_p(k,j,i+1)  &
+                            + 2134.0_wp * sk_p(k,j,i) - 116.0_wp * sk_p(k,j,i-1)  &
+                            + 9.0_wp * sk_p(k,j,i-2) ) * f1920
+                a1(k,i) = ( -5.0_wp * sk_p(k,j,i+2)   + 34.0_wp * sk_p(k,j,i+1)   &
+                            - 34.0_wp * sk_p(k,j,i-1) + 5.0_wp * sk_p(k,j,i-2)    &
+                          ) * f48
+                a2(k,i) = ( -3.0_wp * sk_p(k,j,i+2) + 36.0_wp * sk_p(k,j,i+1)     &
+                            - 66.0_wp * sk_p(k,j,i) + 36.0_wp * sk_p(k,j,i-1)     &
+                            - 3.0_wp * sk_p(k,j,i-2) ) * f48
+             ENDDO
+          ENDDO
+
+!
+!--       Fluxes using the Bott scheme
+!--       *VOCL LOOP,UNROLL(2)
+          DO  i = nxl, nxr
+             DO  k = nzb+1, nzt
+                cip  =  MAX( 0.0_wp, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
+                cim  = -MIN( 0.0_wp, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
+                cipf = 1.0_wp - 2.0_wp * cip
+                cimf = 1.0_wp - 2.0_wp * cim
+                ip   =   a0(k,i)   * f2  * ( 1.0_wp - cipf )                      &
+                       + a1(k,i)   * f8  * ( 1.0_wp - cipf*cipf )                 &
+                       + a2(k,i)   * f24 * ( 1.0_wp - cipf*cipf*cipf )
+                im   =   a0(k,i+1) * f2  * ( 1.0_wp - cimf )                      &
+                       - a1(k,i+1) * f8  * ( 1.0_wp - cimf*cimf )                 &
+                       + a2(k,i+1) * f24 * ( 1.0_wp - cimf*cimf*cimf )
+                ip   = MAX( ip, 0.0_wp )
+                im   = MAX( im, 0.0_wp )
+                ippb(k,i) = ip * MIN( 1.0_wp, sk_p(k,j,i)   / (ip+im+1E-15_wp) )
+                impb(k,i) = im * MIN( 1.0_wp, sk_p(k,j,i+1) / (ip+im+1E-15_wp) )
+
+                cip  =  MAX( 0.0_wp, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
+                cim  = -MIN( 0.0_wp, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
+                cipf = 1.0_wp - 2.0_wp * cip
+                cimf = 1.0_wp - 2.0_wp * cim
+                ip   =   a0(k,i-1) * f2  * ( 1.0_wp - cipf )                      &
+                       + a1(k,i-1) * f8  * ( 1.0_wp - cipf*cipf )                 &
+                       + a2(k,i-1) * f24 * ( 1.0_wp - cipf*cipf*cipf )
+                im   =   a0(k,i)   * f2  * ( 1.0_wp - cimf )                      &
+                       - a1(k,i)   * f8  * ( 1.0_wp - cimf*cimf )                 &
+                       + a2(k,i)   * f24 * ( 1.0_wp - cimf*cimf*cimf )
+                ip   = MAX( ip, 0.0_wp )
+                im   = MAX( im, 0.0_wp )
+                ipmb(k,i) = ip * MIN( 1.0_wp, sk_p(k,j,i-1) / (ip+im+1E-15_wp) )
+                immb(k,i) = im * MIN( 1.0_wp, sk_p(k,j,i)   / (ip+im+1E-15_wp) )
+             ENDDO
+          ENDDO
+
+!
+!--       Compute monitor function m1
+          DO  i = nxl-2, nxr+2
+             DO  k = nzb+1, nzt
+                m1z = ABS( sk_p(k,j,i+1) - 2.0_wp * sk_p(k,j,i) + sk_p(k,j,i-1) )
+                m1n = ABS( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
+                IF ( m1n /= 0.0_wp  .AND.  m1n >= m1z )  THEN
+                   m1(k,i) = m1z / m1n
+                   IF ( m1(k,i) /= 2.0_wp  .AND.  m1n < fmax(2) )  m1(k,i) = 0.0_wp
+                ELSEIF ( m1n < m1z )  THEN
+                   m1(k,i) = -1.0_wp
+                ELSE
+                   m1(k,i) = 0.0_wp
+                ENDIF
+             ENDDO
+          ENDDO
+
+!
+!--       Compute switch sw
+          sw = 0.0_wp
+          DO  i = nxl-1, nxr+1
+             DO  k = nzb+1, nzt
+                m2 = 2.0_wp * ABS( a1(k,i) - a12(k,i) ) /                         &
+                     MAX( ABS( a1(k,i) + a12(k,i) ), 1E-35_wp )
+                IF ( ABS( a1(k,i) + a12(k,i) ) < fmax(2) )  m2 = 0.0_wp
+
+                m3 = 2.0_wp * ABS( a2(k,i) - a22(k,i) ) /                         &
+                     MAX( ABS( a2(k,i) + a22(k,i) ), 1E-35_wp )
+                IF ( ABS( a2(k,i) + a22(k,i) ) < fmax(1) )  m3 = 0.0_wp
+
+                t1 = 0.35_wp
+                t2 = 0.35_wp
+                IF ( m1(k,i) == -1.0_wp )  t2 = 0.12_wp
+
+!--             *VOCL STMT,IF(10)
+                IF ( m1(k,i-1) == 1.0_wp .OR. m1(k,i) == 1.0_wp                   &
+                     .OR. m1(k,i+1) == 1.0_wp .OR.  m2 > t2  .OR.  m3 > t2  .OR.  &
+                     ( m1(k,i) > t1  .AND.  m1(k,i-1) /= -1.0_wp  .AND.           &
+                       m1(k,i) /= -1.0_wp  .AND.  m1(k,i+1) /= -1.0_wp )          &
+                   )  sw(k,i) = 1.0_wp
+             ENDDO
+          ENDDO
+
+!
+!--       Fluxes using the exponential scheme
+          CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'continue' )
+          DO  i = nxl, nxr
+             DO  k = nzb+1, nzt
+
+!--             *VOCL STMT,IF(10)
+                IF ( sw(k,i) == 1.0_wp )  THEN
+                   snenn = sk_p(k,j,i+1) - sk_p(k,j,i-1)
+                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
+                   sterm = ( sk_p(k,j,i) - sk_p(k,j,i-1) ) / snenn
+                   sterm = MIN( sterm, 0.9999_wp )
+                   sterm = MAX( sterm, 0.0001_wp )
+
+                   ix = INT( sterm * 1000 ) + 1
+
+                   cip =  MAX( 0.0_wp, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
+
+                   ippe(k,i) = sk_p(k,j,i-1) * cip + snenn * (                    &
+                               aex(ix) * cip + bex(ix) / dex(ix) * (              &
+                               eex(ix) -                                          &
+                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cip ) )  &
+                                                                   )              &
+                                                             )
+                   IF ( sterm == 0.0001_wp )  ippe(k,i) = sk_p(k,j,i) * cip
+                   IF ( sterm == 0.9999_wp )  ippe(k,i) = sk_p(k,j,i) * cip
+
+                   snenn = sk_p(k,j,i-1) - sk_p(k,j,i+1)
+                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
+                   sterm = ( sk_p(k,j,i) - sk_p(k,j,i+1) ) / snenn
+                   sterm = MIN( sterm, 0.9999_wp )
+                   sterm = MAX( sterm, 0.0001_wp )
+
+                   ix = INT( sterm * 1000 ) + 1
+
+                   cim = -MIN( 0.0_wp, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
+
+                   imme(k,i) = sk_p(k,j,i+1) * cim + snenn * (                    &
+                               aex(ix) * cim + bex(ix) / dex(ix) * (              &
+                               eex(ix) -                                          &
+                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cim ) )  &
+                                                                   )              &
+                                                             )
+                   IF ( sterm == 0.0001_wp )  imme(k,i) = sk_p(k,j,i) * cim
+                   IF ( sterm == 0.9999_wp )  imme(k,i) = sk_p(k,j,i) * cim
+                ENDIF
+
+!--             *VOCL STMT,IF(10)
+                IF ( sw(k,i+1) == 1.0_wp )  THEN
+                   snenn = sk_p(k,j,i) - sk_p(k,j,i+2)
+                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
+                   sterm = ( sk_p(k,j,i+1) - sk_p(k,j,i+2) ) / snenn
+                   sterm = MIN( sterm, 0.9999_wp )
+                   sterm = MAX( sterm, 0.0001_wp )
+
+                   ix = INT( sterm * 1000 ) + 1
+
+                   cim = -MIN( 0.0_wp, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
+
+                   impe(k,i) = sk_p(k,j,i+2) * cim + snenn * (                    &
+                               aex(ix) * cim + bex(ix) / dex(ix) * (              &
+                               eex(ix) -                                          &
+                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cim ) )  &
+                                                                   )              &
+                                                             )
+                   IF ( sterm == 0.0001_wp )  impe(k,i) = sk_p(k,j,i+1) * cim
+                   IF ( sterm == 0.9999_wp )  impe(k,i) = sk_p(k,j,i+1) * cim
+                ENDIF
+
+!--             *VOCL STMT,IF(10)
+                IF ( sw(k,i-1) == 1.0_wp )  THEN
+                   snenn = sk_p(k,j,i) - sk_p(k,j,i-2)
+                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
+                   sterm = ( sk_p(k,j,i-1) - sk_p(k,j,i-2) ) / snenn
+                   sterm = MIN( sterm, 0.9999_wp )
+                   sterm = MAX( sterm, 0.0001_wp )
+
+                   ix = INT( sterm * 1000 ) + 1
+
+                   cip = MAX( 0.0_wp, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
+
+                   ipme(k,i) = sk_p(k,j,i-2) * cip + snenn * (                    &
+                               aex(ix) * cip + bex(ix) / dex(ix) * (              &
+                               eex(ix) -                                          &
+                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cip ) )  &
+                                                                   )              &
+                                                             )
+                   IF ( sterm == 0.0001_wp )  ipme(k,i) = sk_p(k,j,i-1) * cip
+                   IF ( sterm == 0.9999_wp )  ipme(k,i) = sk_p(k,j,i-1) * cip
+                ENDIF
+
+             ENDDO
+          ENDDO
+          CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'pause' )
+
+!
+!--       Prognostic equation
+          DO  i = nxl, nxr
+             DO  k = nzb+1, nzt
+                fplus  = ( 1.0_wp - sw(k,i)   ) * ippb(k,i) + sw(k,i)   * ippe(k,i)  &
+                       - ( 1.0_wp - sw(k,i+1) ) * impb(k,i) - sw(k,i+1) * impe(k,i)
+                fminus = ( 1.0_wp - sw(k,i-1) ) * ipmb(k,i) + sw(k,i-1) * ipme(k,i)  &
+                       - ( 1.0_wp - sw(k,i)   ) * immb(k,i) - sw(k,i)   * imme(k,i)
+                tendcy = fplus - fminus
+!
+!--             Removed in order to optimize speed
+!                ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35_wp )
+!                IF ( ( ABS( tendcy ) / ffmax ) < 1E-7_wp )  tendcy = 0.0
+!
+!--             Density correction because of possible remaining divergences
+                d_new = d(k,j,i) - ( u(k,j,i+1) - u(k,j,i) ) * dt_3d * ddx
+                sk_p(k,j,i) = ( ( 1.0_wp + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) /    &
+                              ( 1.0_wp + d_new )
+                d(k,j,i)  = d_new
+             ENDDO
+          ENDDO
+
+       ENDDO   ! End of the advection in x-direction
+
+!
+!--    Deallocate temporary arrays
+       DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme,      &
+                   ippb, ippe, m1, sw )
+
+
+!
+!--    Enlarge boundary of local array cyclically in y-direction
+#if defined( __parallel )
+       ngp = ( nzt - nzb + 6 ) * ( nyn - nys + 7 )
+       CALL MPI_TYPE_VECTOR( nxr-nxl+7, 3*(nzt-nzb+6), ngp, MPI_REAL,             &
+                             type_xz_2, ierr )
+       CALL MPI_TYPE_COMMIT( type_xz_2, ierr )
+!
+!--    Send front boundary, receive rear boundary
+       CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'continue' )
+       CALL MPI_SENDRECV( sk_p(nzb-2,nys,nxl-3),   1, type_xz_2, psouth, 0,       &
+                          sk_p(nzb-2,nyn+1,nxl-3), 1, type_xz_2, pnorth, 0,       &
+                          comm2d, status, ierr )
+!
+!--    Send rear boundary, receive front boundary
+       CALL MPI_SENDRECV( sk_p(nzb-2,nyn-2,nxl-3), 1, type_xz_2, pnorth, 1,       &
+                          sk_p(nzb-2,nys-3,nxl-3), 1, type_xz_2, psouth, 1,       &
+                          comm2d, status, ierr )
+       CALL MPI_TYPE_FREE( type_xz_2, ierr )
+       CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'pause' )
+#else
+       DO  i = nxl, nxr
+          DO  k = nzb+1, nzt
+             sk_p(k,nys-1,i) = sk_p(k,nyn,i)
+             sk_p(k,nys-2,i) = sk_p(k,nyn-1,i)
+             sk_p(k,nys-3,i) = sk_p(k,nyn-2,i)
+             sk_p(k,nyn+1,i) = sk_p(k,nys,i)
+             sk_p(k,nyn+2,i) = sk_p(k,nys+1,i)
+             sk_p(k,nyn+3,i) = sk_p(k,nys+2,i)
+          ENDDO
+       ENDDO
+#endif
+
+!
+!--    Determine the maxima of the first and second derivative in y-direction
+       fmax_l = 0.0_wp
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                numera = ABS( sk_p(k,j+1,i) - 2.0_wp * sk_p(k,j,i) + sk_p(k,j-1,i) )
+                denomi  = ABS( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
+                fmax_l(1) = MAX( fmax_l(1) , numera )
+                fmax_l(2) = MAX( fmax_l(2) , denomi  )
+             ENDDO
+          ENDDO
+       ENDDO
+#if defined( __parallel )
+       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
+       CALL MPI_ALLREDUCE( fmax_l, fmax, 2, MPI_REAL, MPI_MAX, comm2d, ierr )
+#else
+       fmax = fmax_l
+#endif
+
+       fmax = 0.04_wp * fmax
+
+!
+!--    Allocate temporary arrays
+       ALLOCATE( a0(nzb+1:nzt,nys-1:nyn+1),   a1(nzb+1:nzt,nys-1:nyn+1),          &
+                 a2(nzb+1:nzt,nys-1:nyn+1),   a12(nzb+1:nzt,nys-1:nyn+1),         &
+                 a22(nzb+1:nzt,nys-1:nyn+1),  immb(nzb+1:nzt,nys-1:nyn+1),        &
+                 imme(nzb+1:nzt,nys-1:nyn+1), impb(nzb+1:nzt,nys-1:nyn+1),        &
+                 impe(nzb+1:nzt,nys-1:nyn+1), ipmb(nzb+1:nzt,nys-1:nyn+1),        &
+                 ipme(nzb+1:nzt,nys-1:nyn+1), ippb(nzb+1:nzt,nys-1:nyn+1),        &
+                 ippe(nzb+1:nzt,nys-1:nyn+1), m1(nzb+1:nzt,nys-2:nyn+2),          &
+                 sw(nzb+1:nzt,nys-1:nyn+1)                                        &
+               )
+       imme = 0.0_wp; impe = 0.0_wp; ipme = 0.0_wp; ippe = 0.0_wp
+
+!
+!--    Outer loop of all i
+       DO  i = nxl, nxr
+
+!
+!--       Compute polynomial coefficients
+          DO  j = nys-1, nyn+1
+             DO  k = nzb+1, nzt
+                a12(k,j) = 0.5_wp * ( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
+                a22(k,j) = 0.5_wp * ( sk_p(k,j+1,i) - 2.0_wp * sk_p(k,j,i)        &
+                                                    + sk_p(k,j-1,i) )
+                a0(k,j) = ( 9.0_wp * sk_p(k,j+2,i)    - 116.0_wp * sk_p(k,j+1,i)  &
+                            + 2134.0_wp * sk_p(k,j,i) - 116.0_wp * sk_p(k,j-1,i)  &
+                            + 9.0_wp * sk_p(k,j-2,i) ) * f1920
+                a1(k,j) = ( -5.0_wp   * sk_p(k,j+2,i) + 34.0_wp * sk_p(k,j+1,i)   &
+                            - 34.0_wp * sk_p(k,j-1,i) + 5.0_wp  * sk_p(k,j-2,i)   &
+                          ) * f48
+                a2(k,j) = ( -3.0_wp * sk_p(k,j+2,i) + 36.0_wp * sk_p(k,j+1,i)     &
+                            - 66.0_wp * sk_p(k,j,i) + 36.0_wp * sk_p(k,j-1,i)     &
+                            - 3.0_wp * sk_p(k,j-2,i) ) * f48
+             ENDDO
+          ENDDO
+
+!
+!--       Fluxes using the Bott scheme
+!--       *VOCL LOOP,UNROLL(2)
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                cip  =  MAX( 0.0_wp, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
+                cim  = -MIN( 0.0_wp, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
+                cipf = 1.0_wp - 2.0_wp * cip
+                cimf = 1.0_wp - 2.0_wp * cim
+                ip   =   a0(k,j)   * f2  * ( 1.0_wp - cipf )                      &
+                       + a1(k,j)   * f8  * ( 1.0_wp - cipf*cipf )                 &
+                       + a2(k,j)   * f24 * ( 1.0_wp - cipf*cipf*cipf )
+                im   =   a0(k,j+1) * f2  * ( 1.0_wp - cimf )                      &
+                       - a1(k,j+1) * f8  * ( 1.0_wp - cimf*cimf )                 &
+                       + a2(k,j+1) * f24 * ( 1.0_wp - cimf*cimf*cimf )
+                ip   = MAX( ip, 0.0_wp )
+                im   = MAX( im, 0.0_wp )
+                ippb(k,j) = ip * MIN( 1.0_wp, sk_p(k,j,i)   / (ip+im+1E-15_wp) )
+                impb(k,j) = im * MIN( 1.0_wp, sk_p(k,j+1,i) / (ip+im+1E-15_wp) )
+
+                cip  =  MAX( 0.0_wp, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
+                cim  = -MIN( 0.0_wp, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
+                cipf = 1.0_wp - 2.0_wp * cip
+                cimf = 1.0_wp - 2.0_wp * cim
+                ip   =   a0(k,j-1) * f2  * ( 1.0_wp - cipf )                      &
+                       + a1(k,j-1) * f8  * ( 1.0_wp - cipf*cipf )                 &
+                       + a2(k,j-1) * f24 * ( 1.0_wp - cipf*cipf*cipf )
+                im   =   a0(k,j)   * f2  * ( 1.0_wp - cimf )                      &
+                       - a1(k,j)   * f8  * ( 1.0_wp - cimf*cimf )                 &
+                       + a2(k,j)   * f24 * ( 1.0_wp - cimf*cimf*cimf )
+                ip   = MAX( ip, 0.0_wp )
+                im   = MAX( im, 0.0_wp )
+                ipmb(k,j) = ip * MIN( 1.0_wp, sk_p(k,j-1,i) / (ip+im+1E-15_wp) )
+                immb(k,j) = im * MIN( 1.0_wp, sk_p(k,j,i)   / (ip+im+1E-15_wp) )
+             ENDDO
+          ENDDO
+
+!
+!--       Compute monitor function m1
+          DO  j = nys-2, nyn+2
+             DO  k = nzb+1, nzt
+                m1z = ABS( sk_p(k,j+1,i) - 2.0_wp * sk_p(k,j,i) + sk_p(k,j-1,i) )
+                m1n = ABS( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
+                IF ( m1n /= 0.0_wp  .AND.  m1n >= m1z )  THEN
+                   m1(k,j) = m1z / m1n
+                   IF ( m1(k,j) /= 2.0_wp  .AND.  m1n < fmax(2) )  m1(k,j) = 0.0_wp
+                ELSEIF ( m1n < m1z )  THEN
+                   m1(k,j) = -1.0_wp
+                ELSE
+                   m1(k,j) = 0.0_wp
+                ENDIF
+             ENDDO
+          ENDDO
+
+!
+!--       Compute switch sw
+          sw = 0.0_wp
+          DO  j = nys-1, nyn+1
+             DO  k = nzb+1, nzt
+                m2 = 2.0_wp * ABS( a1(k,j) - a12(k,j) ) /                            &
+                     MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35_wp )
+                IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) )  m2 = 0.0_wp
+
+                m3 = 2.0_wp * ABS( a2(k,j) - a22(k,j) ) /                            &
+                     MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35_wp )
+                IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) )  m3 = 0.0_wp
+
+                t1 = 0.35_wp
+                t2 = 0.35_wp
+                IF ( m1(k,j) == -1.0_wp )  t2 = 0.12_wp
+
+!--             *VOCL STMT,IF(10)
+                IF ( m1(k,j-1) == 1.0_wp .OR. m1(k,j) == 1.0_wp                   &
+                     .OR. m1(k,j+1) == 1.0_wp .OR.  m2 > t2  .OR.  m3 > t2  .OR.  &
+                     ( m1(k,j) > t1  .AND.  m1(k,j-1) /= -1.0_wp  .AND.           &
+                       m1(k,j) /= -1.0_wp  .AND.  m1(k,j+1) /= -1.0_wp )          &
+                   )  sw(k,j) = 1.0_wp
+             ENDDO
+          ENDDO
+
+!
+!--       Fluxes using exponential scheme
+          CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'continue' )
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+
+!--             *VOCL STMT,IF(10)
+                IF ( sw(k,j) == 1.0_wp )  THEN
+                   snenn = sk_p(k,j+1,i) - sk_p(k,j-1,i)
+                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
+                   sterm = ( sk_p(k,j,i) - sk_p(k,j-1,i) ) / snenn
+                   sterm = MIN( sterm, 0.9999_wp )
+                   sterm = MAX( sterm, 0.0001_wp )
+
+                   ix = INT( sterm * 1000 ) + 1
+
+                   cip =  MAX( 0.0_wp, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
+
+                   ippe(k,j) = sk_p(k,j-1,i) * cip + snenn * (                    &
+                               aex(ix) * cip + bex(ix) / dex(ix) * (              &
+                               eex(ix) -                                          &
+                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cip ) )  &
+                                                                   )              &
+                                                             )
+                   IF ( sterm == 0.0001_wp )  ippe(k,j) = sk_p(k,j,i) * cip
+                   IF ( sterm == 0.9999_wp )  ippe(k,j) = sk_p(k,j,i) * cip
+
+                   snenn = sk_p(k,j-1,i) - sk_p(k,j+1,i)
+                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
+                   sterm = ( sk_p(k,j,i) - sk_p(k,j+1,i) ) / snenn
+                   sterm = MIN( sterm, 0.9999_wp )
+                   sterm = MAX( sterm, 0.0001_wp )
+
+                   ix = INT( sterm * 1000 ) + 1
+
+                   cim = -MIN( 0.0_wp, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
+
+                   imme(k,j) = sk_p(k,j+1,i) * cim + snenn * (                    &
+                               aex(ix) * cim + bex(ix) / dex(ix) * (              &
+                               eex(ix) -                                          &
+                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cim ) )  &
+                                                                   )              &
+                                                             )
+                   IF ( sterm == 0.0001_wp )  imme(k,j) = sk_p(k,j,i) * cim
+                   IF ( sterm == 0.9999_wp )  imme(k,j) = sk_p(k,j,i) * cim
+                ENDIF
+
+!--             *VOCL STMT,IF(10)
+                IF ( sw(k,j+1) == 1.0_wp )  THEN
+                   snenn = sk_p(k,j,i) - sk_p(k,j+2,i)
+                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
+                   sterm = ( sk_p(k,j+1,i) - sk_p(k,j+2,i) ) / snenn
+                   sterm = MIN( sterm, 0.9999_wp )
+                   sterm = MAX( sterm, 0.0001_wp )
+
+                   ix = INT( sterm * 1000 ) + 1
+
+                   cim = -MIN( 0.0_wp, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
+
+                   impe(k,j) = sk_p(k,j+2,i) * cim + snenn * (                    &
+                               aex(ix) * cim + bex(ix) / dex(ix) * (              &
+                               eex(ix) -                                          &
+                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cim ) )  &
+                                                                   )              &
+                                                             )
+                   IF ( sterm == 0.0001_wp )  impe(k,j) = sk_p(k,j+1,i) * cim
+                   IF ( sterm == 0.9999_wp )  impe(k,j) = sk_p(k,j+1,i) * cim
+                ENDIF
+
+!--             *VOCL STMT,IF(10)
+                IF ( sw(k,j-1) == 1.0_wp )  THEN
+                   snenn = sk_p(k,j,i) - sk_p(k,j-2,i)
+                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
+                   sterm = ( sk_p(k,j-1,i) - sk_p(k,j-2,i) ) / snenn
+                   sterm = MIN( sterm, 0.9999_wp )
+                   sterm = MAX( sterm, 0.0001_wp )
+
+                   ix = INT( sterm * 1000 ) + 1
+
+                   cip = MAX( 0.0_wp, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
+
+                   ipme(k,j) = sk_p(k,j-2,i) * cip + snenn * (                    &
+                               aex(ix) * cip + bex(ix) / dex(ix) * (              &
+                               eex(ix) -                                          &
+                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cip ) )  &
+                                                                   )              &
+                                                             )
+                   IF ( sterm == 0.0001_wp )  ipme(k,j) = sk_p(k,j-1,i) * cip
+                   IF ( sterm == 0.9999_wp )  ipme(k,j) = sk_p(k,j-1,i) * cip
+                ENDIF
+
+             ENDDO
+          ENDDO
+          CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'pause' )
+
+!
+!--       Prognostic equation
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                fplus  = ( 1.0_wp - sw(k,j)   ) * ippb(k,j) + sw(k,j)   * ippe(k,j) &
+                       - ( 1.0_wp - sw(k,j+1) ) * impb(k,j) - sw(k,j+1) * impe(k,j)
+                fminus = ( 1.0_wp - sw(k,j-1) ) * ipmb(k,j) + sw(k,j-1) * ipme(k,j) &
+                       - ( 1.0_wp - sw(k,j)   ) * immb(k,j) - sw(k,j)   * imme(k,j)
+                tendcy = fplus - fminus
+!
+!--             Removed in order to optimise speed
+!                ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35_wp )
+!                 IF ( ( ABS( tendcy ) / ffmax ) < 1E-7_wp )  tendcy = 0.0
+!
+!--             Density correction because of possible remaining divergences
+                d_new = d(k,j,i) - ( v(k,j+1,i) - v(k,j,i) ) * dt_3d * ddy
+                sk_p(k,j,i) = ( ( 1.0_wp + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) /  &
+                              ( 1.0_wp + d_new )
+                d(k,j,i)  = d_new
+             ENDDO
+          ENDDO
+
+       ENDDO   ! End of the advection in y-direction
+       CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'continue' )
+       CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'stop' )
+
+!
+!--    Deallocate temporary arrays
+       DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme,      &
+                   ippb, ippe, m1, sw )
+
+
+!
+!--    Initialise for the computation of heat fluxes (see below; required in
+!--    UP flow_statistics)
+       IF ( sk_char == 'pt' )  sums_wsts_bc_l = 0.0_wp
+
+!
+!--    Add top and bottom boundaries according to the relevant boundary conditions
+       IF ( sk_char == 'pt' )  THEN
+
+!
+!--       Temperature boundary condition at the bottom boundary
+          IF ( ibc_pt_b == 0 )  THEN
+!
+!--       Dirichlet (fixed surface temperature)
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
+                   sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
+                ENDDO
+             ENDDO
+
+          ELSE
+!
+!--          Neumann (i.e. here zero gradient)
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
+                   sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
+                   sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
+                ENDDO
+             ENDDO
+
+          ENDIF
+
+!
+!--       Temperature boundary condition at the top boundary
+          IF ( ibc_pt_t == 0  .OR.  ibc_pt_t == 1 )  THEN
+!
+!--          Dirichlet or Neumann (zero gradient)
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i)
+                   sk_p(nzt+3,j,i)   = sk_p(nzt+1,j,i)
+                ENDDO
+             ENDDO
+
+          ELSEIF ( ibc_pt_t == 2 )  THEN
+!
+!--          Neumann: dzu(nzt+2:3) are not defined, dzu(nzt+1) is used instead
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i) + bc_pt_t_val * dzu(nzt+1)
+                   sk_p(nzt+3,j,i)   = sk_p(nzt+2,j,i) + bc_pt_t_val * dzu(nzt+1)
+                ENDDO
+             ENDDO
+
+          ENDIF
+
+       ELSEIF ( sk_char == 'sa' )  THEN
+
+!
+!--       Salinity boundary condition at the bottom boundary.
+!--       So far, always Neumann (i.e. here zero gradient) is used
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
+                sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
+                sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
+             ENDDO
+          ENDDO
+
+!
+!--       Salinity boundary condition at the top boundary.
+!--       Dirichlet or Neumann (zero gradient)
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i)
+                sk_p(nzt+3,j,i)   = sk_p(nzt+1,j,i)
+             ENDDO
+          ENDDO
+
+       ELSEIF ( sk_char == 'q' )  THEN
+
+!
+!--       Specific humidity boundary condition at the bottom boundary.
+!--       Dirichlet (fixed surface humidity) or Neumann (i.e. zero gradient)
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
+                sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
+                sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
+             ENDDO
+          ENDDO
+
+!
+!--       Specific humidity boundary condition at the top boundary
+          IF ( ibc_q_t == 0 )  THEN
+!
+!--          Dirichlet
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i)
+                   sk_p(nzt+3,j,i)   = sk_p(nzt+1,j,i)
+                ENDDO
+             ENDDO
+
+          ELSE
+!
+!--          Neumann: dzu(nzt+2:3) are not defined, dzu(nzt+1) is used instead
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i) + bc_q_t_val * dzu(nzt+1)
+                   sk_p(nzt+3,j,i)   = sk_p(nzt+2,j,i) + bc_q_t_val * dzu(nzt+1)
+                ENDDO
+             ENDDO
+
+          ENDIF
+
+       ELSEIF ( sk_char == 'qr' )  THEN
+
+!
+!--       Rain water content boundary condition at the bottom boundary:
+!--       Dirichlet (fixed surface rain water content).
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
+                sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
+                sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
+             ENDDO
+          ENDDO
+
+!
+!--       Rain water content boundary condition at the top boundary: Dirichlet
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i)
+                sk_p(nzt+3,j,i)   = sk_p(nzt+1,j,i)
+             ENDDO
+          ENDDO
+
+       ELSEIF ( sk_char == 'nr' )  THEN
+
+!
+!--       Rain drop concentration boundary condition at the bottom boundary:
+!--       Dirichlet (fixed surface rain drop concentration).
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
+                sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
+                sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
+             ENDDO
+          ENDDO
+
+!
+!--       Rain drop concentration boundary condition at the top boundary: Dirichlet
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i)
+                sk_p(nzt+3,j,i)   = sk_p(nzt+1,j,i)
+             ENDDO
+          ENDDO
+
+       ELSEIF ( sk_char == 'e' )  THEN
+
+!
+!--       TKE boundary condition at bottom and top boundary (generally Neumann)
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
+                sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
+                sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
+                sk_p(nzt+2,j,i) = sk_p(nzt+1,j,i)
+                sk_p(nzt+3,j,i) = sk_p(nzt+1,j,i)
+             ENDDO
+          ENDDO
+
+       ELSE
+
+          WRITE( message_string, * ) 'no vertical boundary condi',                &
+                                   'tion for variable "', sk_char, '"'
+          CALL message( 'advec_s_bc', 'PA0158', 1, 2, 0, 6, 0 )
+         
+       ENDIF
+
+!
+!--    Determine the maxima of the first and second derivative in z-direction
+       fmax_l = 0.0_wp
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb, nzt+1
+                numera = ABS( sk_p(k+1,j,i) - 2.0_wp * sk_p(k,j,i) + sk_p(k-1,j,i) )
+                denomi  = ABS( sk_p(k+1,j,i+1) - sk_p(k-1,j,i) )
+                fmax_l(1) = MAX( fmax_l(1) , numera )
+                fmax_l(2) = MAX( fmax_l(2) , denomi  )
+             ENDDO
+          ENDDO
+       ENDDO
+#if defined( __parallel )
+       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
+       CALL MPI_ALLREDUCE( fmax_l, fmax, 2, MPI_REAL, MPI_MAX, comm2d, ierr )
+#else
+       fmax = fmax_l
+#endif
+
+       fmax = 0.04_wp * fmax
+
+!
+!--    Allocate temporary arrays
+       ALLOCATE( a0(nzb:nzt+1,nys:nyn),   a1(nzb:nzt+1,nys:nyn),                  &
+                 a2(nzb:nzt+1,nys:nyn),   a12(nzb:nzt+1,nys:nyn),                 &
+                 a22(nzb:nzt+1,nys:nyn),  immb(nzb+1:nzt,nys:nyn),                &
+                 imme(nzb+1:nzt,nys:nyn), impb(nzb+1:nzt,nys:nyn),                &
+                 impe(nzb+1:nzt,nys:nyn), ipmb(nzb+1:nzt,nys:nyn),                &
+                 ipme(nzb+1:nzt,nys:nyn), ippb(nzb+1:nzt,nys:nyn),                &
+                 ippe(nzb+1:nzt,nys:nyn), m1(nzb-1:nzt+2,nys:nyn),                &
+                 sw(nzb:nzt+1,nys:nyn)                                            &
+               )
+       imme = 0.0_wp; impe = 0.0_wp; ipme = 0.0_wp; ippe = 0.0_wp
+
+!
+!--    Outer loop of all i
+       DO  i = nxl, nxr
+
+!
+!--       Compute polynomial coefficients
+          DO  j = nys, nyn
+             DO  k = nzb, nzt+1
+                a12(k,j) = 0.5_wp * ( sk_p(k+1,j,i) - sk_p(k-1,j,i) )
+                a22(k,j) = 0.5_wp * ( sk_p(k+1,j,i) - 2.0_wp * sk_p(k,j,i)        &
+                                                    + sk_p(k-1,j,i) )
+                a0(k,j) = ( 9.0_wp * sk_p(k+2,j,i)    - 116.0_wp * sk_p(k+1,j,i)  &
+                            + 2134.0_wp * sk_p(k,j,i) - 116.0_wp * sk_p(k-1,j,i)  &
+                            + 9.0_wp * sk_p(k-2,j,i) ) * f1920
+                a1(k,j) = ( -5.0_wp   * sk_p(k+2,j,i) + 34.0_wp * sk_p(k+1,j,i)   &
+                            - 34.0_wp * sk_p(k-1,j,i) + 5.0_wp  * sk_p(k-2,j,i)   &
+                          ) * f48
+                a2(k,j) = ( -3.0_wp * sk_p(k+2,j,i) + 36.0_wp * sk_p(k+1,j,i)     &
+                            - 66.0_wp * sk_p(k,j,i) + 36.0_wp * sk_p(k-1,j,i)     &
+                            - 3.0_wp * sk_p(k-2,j,i) ) * f48
+             ENDDO
+          ENDDO
+
+!
+!--       Fluxes using the Bott scheme
+!--       *VOCL LOOP,UNROLL(2)
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                cip  =  MAX( 0.0_wp, w(k,j,i) * dt_3d * ddzw(k) )
+                cim  = -MIN( 0.0_wp, w(k,j,i) * dt_3d * ddzw(k) )
+                cipf = 1.0_wp - 2.0_wp * cip
+                cimf = 1.0_wp - 2.0_wp * cim
+                ip   =   a0(k,j)   * f2  * ( 1.0_wp - cipf )                      &
+                       + a1(k,j)   * f8  * ( 1.0_wp - cipf*cipf )                 &
+                       + a2(k,j)   * f24 * ( 1.0_wp - cipf*cipf*cipf )
+                im   =   a0(k+1,j) * f2  * ( 1.0_wp - cimf )                      &
+                       - a1(k+1,j) * f8  * ( 1.0_wp - cimf*cimf )                 &
+                       + a2(k+1,j) * f24 * ( 1.0_wp - cimf*cimf*cimf )
+                ip   = MAX( ip, 0.0_wp )
+                im   = MAX( im, 0.0_wp )
+                ippb(k,j) = ip * MIN( 1.0_wp, sk_p(k,j,i)   / (ip+im+1E-15_wp) )
+                impb(k,j) = im * MIN( 1.0_wp, sk_p(k+1,j,i) / (ip+im+1E-15_wp) )
+
+                cip  =  MAX( 0.0_wp, w(k-1,j,i) * dt_3d * ddzw(k) )
+                cim  = -MIN( 0.0_wp, w(k-1,j,i) * dt_3d * ddzw(k) )
+                cipf = 1.0_wp - 2.0_wp * cip
+                cimf = 1.0_wp - 2.0_wp * cim
+                ip   =   a0(k-1,j) * f2  * ( 1.0_wp - cipf )                      &
+                       + a1(k-1,j) * f8  * ( 1.0_wp - cipf*cipf )                 &
+                       + a2(k-1,j) * f24 * ( 1.0_wp - cipf*cipf*cipf )
+                im   =   a0(k,j)   * f2  * ( 1.0_wp - cimf )                      &
+                       - a1(k,j)   * f8  * ( 1.0_wp - cimf*cimf )                 &
+                       + a2(k,j)   * f24 * ( 1.0_wp - cimf*cimf*cimf )
+                ip   = MAX( ip, 0.0_wp )
+                im   = MAX( im, 0.0_wp )
+                ipmb(k,j) = ip * MIN( 1.0_wp, sk_p(k-1,j,i) / (ip+im+1E-15_wp) )
+                immb(k,j) = im * MIN( 1.0_wp, sk_p(k,j,i)   / (ip+im+1E-15_wp) )
+             ENDDO
+          ENDDO
+
+!
+!--       Compute monitor function m1
+          DO  j = nys, nyn
+             DO  k = nzb-1, nzt+2
+                m1z = ABS( sk_p(k+1,j,i) - 2.0_wp * sk_p(k,j,i) + sk_p(k-1,j,i) )
+                m1n = ABS( sk_p(k+1,j,i) - sk_p(k-1,j,i) )
+                IF ( m1n /= 0.0_wp  .AND.  m1n >= m1z )  THEN
+                   m1(k,j) = m1z / m1n
+                   IF ( m1(k,j) /= 2.0_wp  .AND.  m1n < fmax(2) )  m1(k,j) = 0.0_wp
+                ELSEIF ( m1n < m1z )  THEN
+                   m1(k,j) = -1.0_wp
+                ELSE
+                   m1(k,j) = 0.0_wp
+                ENDIF
+             ENDDO
+          ENDDO
+
+!
+!--       Compute switch sw
+          sw = 0.0_wp
+          DO  j = nys, nyn
+             DO  k = nzb, nzt+1
+                m2 = 2.0_wp * ABS( a1(k,j) - a12(k,j) ) /                         &
+                     MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35_wp )
+                IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) )  m2 = 0.0_wp
+
+                m3 = 2.0_wp * ABS( a2(k,j) - a22(k,j) ) /                         &
+                     MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35_wp )
+                IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) )  m3 = 0.0_wp
+
+                t1 = 0.35_wp
+                t2 = 0.35_wp
+                IF ( m1(k,j) == -1.0_wp )  t2 = 0.12_wp
+
+!--             *VOCL STMT,IF(10)
+                IF ( m1(k-1,j) == 1.0_wp .OR. m1(k,j) == 1.0_wp                   &
+                     .OR. m1(k+1,j) == 1.0_wp .OR.  m2 > t2  .OR.  m3 > t2  .OR.  &
+                     ( m1(k,j) > t1  .AND.  m1(k-1,j) /= -1.0_wp  .AND.           &
+                       m1(k,j) /= -1.0_wp  .AND.  m1(k+1,j) /= -1.0_wp )          &
+                   )  sw(k,j) = 1.0_wp
+             ENDDO
+          ENDDO
+
+!
+!--       Fluxes using exponential scheme
+          CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'continue' )
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+
+!--             *VOCL STMT,IF(10)
+                IF ( sw(k,j) == 1.0_wp )  THEN
+                   snenn = sk_p(k+1,j,i) - sk_p(k-1,j,i)
+                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
+                   sterm = ( sk_p(k,j,i) - sk_p(k-1,j,i) ) / snenn
+                   sterm = MIN( sterm, 0.9999_wp )
+                   sterm = MAX( sterm, 0.0001_wp )
+
+                   ix = INT( sterm * 1000 ) + 1
+
+                   cip =  MAX( 0.0_wp, w(k,j,i) * dt_3d * ddzw(k) )
+
+                   ippe(k,j) = sk_p(k-1,j,i) * cip + snenn * (                    &
+                               aex(ix) * cip + bex(ix) / dex(ix) * (              &
+                               eex(ix) -                                          &
+                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cip ) )  &
+                                                                   )              &
+                                                             )
+                   IF ( sterm == 0.0001_wp )  ippe(k,j) = sk_p(k,j,i) * cip
+                   IF ( sterm == 0.9999_wp )  ippe(k,j) = sk_p(k,j,i) * cip
+
+                   snenn = sk_p(k-1,j,i) - sk_p(k+1,j,i)
+                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
+                   sterm = ( sk_p(k,j,i) - sk_p(k+1,j,i) ) / snenn
+                   sterm = MIN( sterm, 0.9999_wp )
+                   sterm = MAX( sterm, 0.0001_wp )
+
+                   ix = INT( sterm * 1000 ) + 1
+
+                   cim = -MIN( 0.0_wp, w(k-1,j,i) * dt_3d * ddzw(k) )
+
+                   imme(k,j) = sk_p(k+1,j,i) * cim + snenn * (                    &
+                               aex(ix) * cim + bex(ix) / dex(ix) * (              &
+                               eex(ix) -                                          &
+                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cim ) ) &
+                                                                   )              &
+                                                             )
+                   IF ( sterm == 0.0001_wp )  imme(k,j) = sk_p(k,j,i) * cim
+                   IF ( sterm == 0.9999_wp )  imme(k,j) = sk_p(k,j,i) * cim
+                ENDIF
+
+!--             *VOCL STMT,IF(10)
+                IF ( sw(k+1,j) == 1.0_wp )  THEN
+                   snenn = sk_p(k,j,i) - sk_p(k+2,j,i)
+                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
+                   sterm = ( sk_p(k+1,j,i) - sk_p(k+2,j,i) ) / snenn
+                   sterm = MIN( sterm, 0.9999_wp )
+                   sterm = MAX( sterm, 0.0001_wp )
+
+                   ix = INT( sterm * 1000 ) + 1
+
+                   cim = -MIN( 0.0_wp, w(k,j,i) * dt_3d * ddzw(k) )
+
+                   impe(k,j) = sk_p(k+2,j,i) * cim + snenn * (                    &
+                               aex(ix) * cim + bex(ix) / dex(ix) * (              &
+                               eex(ix) -                                          &
+                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cim ) )  &
+                                                                   )              &
+                                                             )
+                   IF ( sterm == 0.0001_wp )  impe(k,j) = sk_p(k+1,j,i) * cim
+                   IF ( sterm == 0.9999_wp )  impe(k,j) = sk_p(k+1,j,i) * cim
+                ENDIF
+
+!--             *VOCL STMT,IF(10)
+                IF ( sw(k-1,j) == 1.0_wp )  THEN
+                   snenn = sk_p(k,j,i) - sk_p(k-2,j,i)
+                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
+                   sterm = ( sk_p(k-1,j,i) - sk_p(k-2,j,i) ) / snenn
+                   sterm = MIN( sterm, 0.9999_wp )
+                   sterm = MAX( sterm, 0.0001_wp )
+
+                   ix = INT( sterm * 1000 ) + 1
+
+                   cip = MAX( 0.0_wp, w(k-1,j,i) * dt_3d * ddzw(k) )
+
+                   ipme(k,j) = sk_p(k-2,j,i) * cip + snenn * (                    &
+                               aex(ix) * cip + bex(ix) / dex(ix) * (              &
+                               eex(ix) -                                          &
+                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cip ) )  &
+                                                                   )              &
+                                                             )
+                   IF ( sterm == 0.0001_wp )  ipme(k,j) = sk_p(k-1,j,i) * cip
+                   IF ( sterm == 0.9999_wp )  ipme(k,j) = sk_p(k-1,j,i) * cip
+                ENDIF
+
+             ENDDO
+          ENDDO
+          CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'pause' )
+
+!
+!--       Prognostic equation
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                fplus  = ( 1.0_wp - sw(k,j)   ) * ippb(k,j) + sw(k,j)   * ippe(k,j) &
+                       - ( 1.0_wp - sw(k+1,j) ) * impb(k,j) - sw(k+1,j) * impe(k,j)
+                fminus = ( 1.0_wp - sw(k-1,j) ) * ipmb(k,j) + sw(k-1,j) * ipme(k,j) &
+                       - ( 1.0_wp - sw(k,j)   ) * immb(k,j) - sw(k,j)   * imme(k,j)
+                tendcy = fplus - fminus
+!
+!--              Removed in order to optimise speed
+!                ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35_wp )
+!                IF ( ( ABS( tendcy ) / ffmax ) < 1E-7_wp )  tendcy = 0.0
+!
+!--             Density correction because of possible remaining divergences
+                d_new = d(k,j,i) - ( w(k,j,i) - w(k-1,j,i) ) * dt_3d * ddzw(k)
+                sk_p(k,j,i) = ( ( 1.0_wp + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) /  &
+                              ( 1.0_wp + d_new )
+!
+!--             Store heat flux for subsequent statistics output.
+!--             array m1 is here used as temporary storage
+                m1(k,j) = fplus / dt_3d * dzw(k)
+             ENDDO
+          ENDDO
+
+!
+!--       Sum up heat flux in order to order to obtain horizontal averages
+          IF ( sk_char == 'pt' )  THEN
+             DO  sr = 0, statistic_regions
+                DO  j = nys, nyn
+                   DO  k = nzb+1, nzt
+                      sums_wsts_bc_l(k,sr) = sums_wsts_bc_l(k,sr) +               &
+                                             m1(k,j) * rmask(j,i,sr)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+
+       ENDDO   ! End of the advection in z-direction
+       CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'continue' )
+       CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'stop' )
+
+!
+!--    Deallocate temporary arrays
+       DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme,      &
+                   ippb, ippe, m1, sw )
+
+!
+!--    Store results as tendency and deallocate local array
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                tend(k,j,i) = tend(k,j,i) + ( sk_p(k,j,i) - sk(k,j,i) ) / dt_3d
+             ENDDO
+          ENDDO
+       ENDDO
+
+       DEALLOCATE( sk_p )
+
+    END SUBROUTINE advec_s_bc
+
+ END MODULE advec_s_bc_mod
Index: lm/trunk/SOURCE/advec_s_bc_mod.f90
===================================================================
--- /palm/trunk/SOURCE/advec_s_bc_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,1327 +1,0 @@
-!> @file advec_s_bc_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-!
-! 1815 2016-04-06 13:49:59Z raasch
-! comment change
-!
-! 1691 2015-10-26 16:17:44Z maronga
-! Formatting corrections
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable
-! 
-! 1517 2015-01-07 19:12:25Z hoffmann
-! interface added to advec_s_bc
-!
-! 1374 2014-04-25 12:55:07Z raasch
-! missing variables added to ONLY list
-! 
-! 1361 2014-04-16 15:17:48Z hoffmann
-! nr and qr added
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1346 2014-03-27 13:18:20Z heinze
-! Bugfix: REAL constants provided with KIND-attribute especially in call of 
-! intrinsic function like MAX, MIN, SIGN
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1318 2014-03-17 13:35:16Z raasch
-! module interfaces removed
-!
-! 1092 2013-02-02 11:24:22Z raasch
-! unused variables removed
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1010 2012-09-20 07:59:54Z raasch
-! cpp switch __nopointer added for pointer free version
-!
-! Revision 1.1  1997/08/29 08:53:46  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Advection term for scalar quantities using the Bott-Chlond scheme.
-!> Computation in individual steps for each of the three dimensions.
-!> Limiting assumptions:
-!> So far the scheme has been assuming equidistant grid spacing. As this is not
-!> the case in the stretched portion of the z-direction, there dzw(k) is used as
-!> a substitute for a constant grid length. This certainly causes incorrect
-!> results; however, it is hoped that they are not too apparent for weakly 
-!> stretched grids.
-!> NOTE: This is a provisional, non-optimised version!
-!------------------------------------------------------------------------------!
-MODULE advec_s_bc_mod
- 
-
-    PRIVATE
-    PUBLIC advec_s_bc
-
-    INTERFACE advec_s_bc
-       MODULE PROCEDURE advec_s_bc
-    END INTERFACE advec_s_bc
-
- CONTAINS
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_s_bc( sk, sk_char )
-
-       USE advection,                                                             &
-           ONLY:  aex, bex, dex, eex
-
-       USE arrays_3d,                                                             &
-           ONLY:  d, ddzw, dzu, dzw, tend, u, v, w
-
-       USE control_parameters,                                                    &
-           ONLY:  dt_3d, bc_pt_t_val, bc_q_t_val, ibc_pt_b, ibc_pt_t, ibc_q_t,    &
-                  message_string, pt_slope_offset, sloping_surface, u_gtrans,     &
-                  v_gtrans
-
-       USE cpulog,                                                                &
-           ONLY:  cpu_log, log_point_s
-
-       USE grid_variables,                                                        &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                               &
-           ONLY:  nx, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
-
-       USE kinds
-
-       USE pegrid
-
-       USE statistics,                                                            &
-           ONLY:  rmask, statistic_regions, sums_wsts_bc_l
-
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  sk_char !<
-
-       INTEGER(iwp) ::  i         !<
-       INTEGER(iwp) ::  ix        !<
-       INTEGER(iwp) ::  j         !<
-       INTEGER(iwp) ::  k         !<
-       INTEGER(iwp) ::  ngp       !<
-       INTEGER(iwp) ::  sr        !<
-       INTEGER(iwp) ::  type_xz_2 !<
-
-       REAL(wp) ::  cim    !<
-       REAL(wp) ::  cimf   !<
-       REAL(wp) ::  cip    !<
-       REAL(wp) ::  cipf   !<
-       REAL(wp) ::  d_new  !<
-       REAL(wp) ::  denomi !< denominator
-       REAL(wp) ::  fminus !<
-       REAL(wp) ::  fplus  !<
-       REAL(wp) ::  f2     !<
-       REAL(wp) ::  f4     !<
-       REAL(wp) ::  f8     !<
-       REAL(wp) ::  f12    !<
-       REAL(wp) ::  f24    !<
-       REAL(wp) ::  f48    !<
-       REAL(wp) ::  f1920  !<
-       REAL(wp) ::  im     !<
-       REAL(wp) ::  ip     !<
-       REAL(wp) ::  m2     !<
-       REAL(wp) ::  m3     !<
-       REAL(wp) ::  numera !< numerator
-       REAL(wp) ::  snenn  !<
-       REAL(wp) ::  sterm  !<
-       REAL(wp) ::  tendcy !<
-       REAL(wp) ::  t1     !<
-       REAL(wp) ::  t2     !<
-
-       REAL(wp) ::  fmax(2)   !<
-       REAL(wp) ::  fmax_l(2) !<
-       
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
-#endif
-
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a0   !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a1   !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a12  !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a2   !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  a22  !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  immb !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  imme !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  impb !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  impe !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ipmb !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ipme !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ippb !<
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ippe !<
-       
-       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  sk_p !<
-
-#if defined( __nec )
-       REAL(sp) ::  m1n, m1z  !< important for optimisation of division
-       REAL(sp), DIMENSION(:,:), ALLOCATABLE :: m1, sw !<
-#else
-       REAL(wp) ::  m1n, m1z 
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m1, sw
-#endif
-
-
-!
-!--    Array sk_p requires 2 extra elements for each dimension
-       ALLOCATE( sk_p(nzb-2:nzt+3,nys-3:nyn+3,nxl-3:nxr+3) )
-       sk_p = 0.0_wp
-
-!
-!--    Assign reciprocal values in order to avoid divisions later
-       f2    = 0.5_wp
-       f4    = 0.25_wp
-       f8    = 0.125_wp
-       f12   = 0.8333333333333333E-01_wp
-       f24   = 0.4166666666666666E-01_wp
-       f48   = 0.2083333333333333E-01_wp
-       f1920 = 0.5208333333333333E-03_wp
-
-!
-!--    Advection in x-direction:
-
-!
-!--    Save the quantity to be advected in a local array
-!--    add an enlarged boundary in x-direction
-       DO  i = nxl-1, nxr+1
-          DO  j = nys, nyn
-             DO  k = nzb, nzt+1
-                sk_p(k,j,i) = sk(k,j,i)
-             ENDDO
-          ENDDO
-       ENDDO
-#if defined( __parallel )
-       ngp = 2 * ( nzt - nzb + 6 ) * ( nyn - nys + 7 )
-       CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'start' )
-!
-!--    Send left boundary, receive right boundary
-       CALL MPI_SENDRECV( sk_p(nzb-2,nys-3,nxl+1), ngp, MPI_REAL, pleft,  0,      &
-                          sk_p(nzb-2,nys-3,nxr+2), ngp, MPI_REAL, pright, 0,      &
-                          comm2d, status, ierr )
-!
-!--    Send right boundary, receive left boundary
-       CALL MPI_SENDRECV( sk_p(nzb-2,nys-3,nxr-2), ngp, MPI_REAL, pright, 1,      &
-                          sk_p(nzb-2,nys-3,nxl-3), ngp, MPI_REAL, pleft,  1,      &
-                          comm2d, status, ierr )
-       CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'pause' )
-#else
-
-!
-!--    Cyclic boundary conditions
-       sk_p(:,nys:nyn,nxl-3) = sk_p(:,nys:nyn,nxr-2)
-       sk_p(:,nys:nyn,nxl-2) = sk_p(:,nys:nyn,nxr-1)
-       sk_p(:,nys:nyn,nxr+2) = sk_p(:,nys:nyn,nxl+1)
-       sk_p(:,nys:nyn,nxr+3) = sk_p(:,nys:nyn,nxl+2)
-#endif
-
-!
-!--    In case of a sloping surface, the additional gridpoints in x-direction
-!--    of the temperature field at the left and right boundary of the total
-!--    domain must be adjusted by the temperature difference between this distance
-       IF ( sloping_surface  .AND.  sk_char == 'pt' )  THEN
-          IF ( nxl ==  0 )  THEN
-             sk_p(:,nys:nyn,nxl-3) = sk_p(:,nys:nyn,nxl-3) - pt_slope_offset
-             sk_p(:,nys:nyn,nxl-2) = sk_p(:,nys:nyn,nxl-2) - pt_slope_offset
-          ENDIF
-          IF ( nxr == nx )  THEN
-             sk_p(:,nys:nyn,nxr+2) = sk_p(:,nys:nyn,nxr+2) + pt_slope_offset
-             sk_p(:,nys:nyn,nxr+3) = sk_p(:,nys:nyn,nxr+3) + pt_slope_offset
-          ENDIF
-       ENDIF
-
-!
-!--    Initialise control density
-       d = 0.0_wp
-
-!
-!--    Determine maxima of the first and second derivative in x-direction
-       fmax_l = 0.0_wp
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                numera = ABS( sk_p(k,j,i+1) - 2.0_wp * sk_p(k,j,i) + sk_p(k,j,i-1) )
-                denomi  = ABS( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
-                fmax_l(1) = MAX( fmax_l(1) , numera )
-                fmax_l(2) = MAX( fmax_l(2) , denomi  )
-             ENDDO
-          ENDDO
-       ENDDO
-#if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( fmax_l, fmax, 2, MPI_REAL, MPI_MAX, comm2d, ierr )
-#else
-       fmax = fmax_l
-#endif
-
-       fmax = 0.04_wp * fmax
-
-!
-!--    Allocate temporary arrays
-       ALLOCATE( a0(nzb+1:nzt,nxl-1:nxr+1),   a1(nzb+1:nzt,nxl-1:nxr+1),          &
-                 a2(nzb+1:nzt,nxl-1:nxr+1),   a12(nzb+1:nzt,nxl-1:nxr+1),         &
-                 a22(nzb+1:nzt,nxl-1:nxr+1),  immb(nzb+1:nzt,nxl-1:nxr+1),        &
-                 imme(nzb+1:nzt,nxl-1:nxr+1), impb(nzb+1:nzt,nxl-1:nxr+1),        &
-                 impe(nzb+1:nzt,nxl-1:nxr+1), ipmb(nzb+1:nzt,nxl-1:nxr+1),        &
-                 ipme(nzb+1:nzt,nxl-1:nxr+1), ippb(nzb+1:nzt,nxl-1:nxr+1),        &
-                 ippe(nzb+1:nzt,nxl-1:nxr+1), m1(nzb+1:nzt,nxl-2:nxr+2),          &
-                 sw(nzb+1:nzt,nxl-1:nxr+1)                                        &
-               )
-       imme = 0.0_wp; impe = 0.0_wp; ipme = 0.0_wp; ippe = 0.0_wp
-
-!
-!--    Initialise point of time measuring of the exponential portion (this would
-!--    not work if done locally within the loop)
-       CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'start' )
-       CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'pause' )
-
-!
-!--    Outer loop of all j
-       DO  j = nys, nyn
-
-!
-!--       Compute polynomial coefficients
-          DO  i = nxl-1, nxr+1
-             DO  k = nzb+1, nzt
-                a12(k,i) = 0.5_wp * ( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
-                a22(k,i) = 0.5_wp * ( sk_p(k,j,i+1) - 2.0_wp * sk_p(k,j,i)        &
-                                                    + sk_p(k,j,i-1) )
-                a0(k,i) = ( 9.0_wp * sk_p(k,j,i+2)    - 116.0_wp * sk_p(k,j,i+1)  &
-                            + 2134.0_wp * sk_p(k,j,i) - 116.0_wp * sk_p(k,j,i-1)  &
-                            + 9.0_wp * sk_p(k,j,i-2) ) * f1920
-                a1(k,i) = ( -5.0_wp * sk_p(k,j,i+2)   + 34.0_wp * sk_p(k,j,i+1)   &
-                            - 34.0_wp * sk_p(k,j,i-1) + 5.0_wp * sk_p(k,j,i-2)    &
-                          ) * f48
-                a2(k,i) = ( -3.0_wp * sk_p(k,j,i+2) + 36.0_wp * sk_p(k,j,i+1)     &
-                            - 66.0_wp * sk_p(k,j,i) + 36.0_wp * sk_p(k,j,i-1)     &
-                            - 3.0_wp * sk_p(k,j,i-2) ) * f48
-             ENDDO
-          ENDDO
-
-!
-!--       Fluxes using the Bott scheme
-!--       *VOCL LOOP,UNROLL(2)
-          DO  i = nxl, nxr
-             DO  k = nzb+1, nzt
-                cip  =  MAX( 0.0_wp, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
-                cim  = -MIN( 0.0_wp, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
-                cipf = 1.0_wp - 2.0_wp * cip
-                cimf = 1.0_wp - 2.0_wp * cim
-                ip   =   a0(k,i)   * f2  * ( 1.0_wp - cipf )                      &
-                       + a1(k,i)   * f8  * ( 1.0_wp - cipf*cipf )                 &
-                       + a2(k,i)   * f24 * ( 1.0_wp - cipf*cipf*cipf )
-                im   =   a0(k,i+1) * f2  * ( 1.0_wp - cimf )                      &
-                       - a1(k,i+1) * f8  * ( 1.0_wp - cimf*cimf )                 &
-                       + a2(k,i+1) * f24 * ( 1.0_wp - cimf*cimf*cimf )
-                ip   = MAX( ip, 0.0_wp )
-                im   = MAX( im, 0.0_wp )
-                ippb(k,i) = ip * MIN( 1.0_wp, sk_p(k,j,i)   / (ip+im+1E-15_wp) )
-                impb(k,i) = im * MIN( 1.0_wp, sk_p(k,j,i+1) / (ip+im+1E-15_wp) )
-
-                cip  =  MAX( 0.0_wp, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
-                cim  = -MIN( 0.0_wp, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
-                cipf = 1.0_wp - 2.0_wp * cip
-                cimf = 1.0_wp - 2.0_wp * cim
-                ip   =   a0(k,i-1) * f2  * ( 1.0_wp - cipf )                      &
-                       + a1(k,i-1) * f8  * ( 1.0_wp - cipf*cipf )                 &
-                       + a2(k,i-1) * f24 * ( 1.0_wp - cipf*cipf*cipf )
-                im   =   a0(k,i)   * f2  * ( 1.0_wp - cimf )                      &
-                       - a1(k,i)   * f8  * ( 1.0_wp - cimf*cimf )                 &
-                       + a2(k,i)   * f24 * ( 1.0_wp - cimf*cimf*cimf )
-                ip   = MAX( ip, 0.0_wp )
-                im   = MAX( im, 0.0_wp )
-                ipmb(k,i) = ip * MIN( 1.0_wp, sk_p(k,j,i-1) / (ip+im+1E-15_wp) )
-                immb(k,i) = im * MIN( 1.0_wp, sk_p(k,j,i)   / (ip+im+1E-15_wp) )
-             ENDDO
-          ENDDO
-
-!
-!--       Compute monitor function m1
-          DO  i = nxl-2, nxr+2
-             DO  k = nzb+1, nzt
-                m1z = ABS( sk_p(k,j,i+1) - 2.0_wp * sk_p(k,j,i) + sk_p(k,j,i-1) )
-                m1n = ABS( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
-                IF ( m1n /= 0.0_wp  .AND.  m1n >= m1z )  THEN
-                   m1(k,i) = m1z / m1n
-                   IF ( m1(k,i) /= 2.0_wp  .AND.  m1n < fmax(2) )  m1(k,i) = 0.0_wp
-                ELSEIF ( m1n < m1z )  THEN
-                   m1(k,i) = -1.0_wp
-                ELSE
-                   m1(k,i) = 0.0_wp
-                ENDIF
-             ENDDO
-          ENDDO
-
-!
-!--       Compute switch sw
-          sw = 0.0_wp
-          DO  i = nxl-1, nxr+1
-             DO  k = nzb+1, nzt
-                m2 = 2.0_wp * ABS( a1(k,i) - a12(k,i) ) /                         &
-                     MAX( ABS( a1(k,i) + a12(k,i) ), 1E-35_wp )
-                IF ( ABS( a1(k,i) + a12(k,i) ) < fmax(2) )  m2 = 0.0_wp
-
-                m3 = 2.0_wp * ABS( a2(k,i) - a22(k,i) ) /                         &
-                     MAX( ABS( a2(k,i) + a22(k,i) ), 1E-35_wp )
-                IF ( ABS( a2(k,i) + a22(k,i) ) < fmax(1) )  m3 = 0.0_wp
-
-                t1 = 0.35_wp
-                t2 = 0.35_wp
-                IF ( m1(k,i) == -1.0_wp )  t2 = 0.12_wp
-
-!--             *VOCL STMT,IF(10)
-                IF ( m1(k,i-1) == 1.0_wp .OR. m1(k,i) == 1.0_wp                   &
-                     .OR. m1(k,i+1) == 1.0_wp .OR.  m2 > t2  .OR.  m3 > t2  .OR.  &
-                     ( m1(k,i) > t1  .AND.  m1(k,i-1) /= -1.0_wp  .AND.           &
-                       m1(k,i) /= -1.0_wp  .AND.  m1(k,i+1) /= -1.0_wp )          &
-                   )  sw(k,i) = 1.0_wp
-             ENDDO
-          ENDDO
-
-!
-!--       Fluxes using the exponential scheme
-          CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'continue' )
-          DO  i = nxl, nxr
-             DO  k = nzb+1, nzt
-
-!--             *VOCL STMT,IF(10)
-                IF ( sw(k,i) == 1.0_wp )  THEN
-                   snenn = sk_p(k,j,i+1) - sk_p(k,j,i-1)
-                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
-                   sterm = ( sk_p(k,j,i) - sk_p(k,j,i-1) ) / snenn
-                   sterm = MIN( sterm, 0.9999_wp )
-                   sterm = MAX( sterm, 0.0001_wp )
-
-                   ix = INT( sterm * 1000 ) + 1
-
-                   cip =  MAX( 0.0_wp, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
-
-                   ippe(k,i) = sk_p(k,j,i-1) * cip + snenn * (                    &
-                               aex(ix) * cip + bex(ix) / dex(ix) * (              &
-                               eex(ix) -                                          &
-                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cip ) )  &
-                                                                   )              &
-                                                             )
-                   IF ( sterm == 0.0001_wp )  ippe(k,i) = sk_p(k,j,i) * cip
-                   IF ( sterm == 0.9999_wp )  ippe(k,i) = sk_p(k,j,i) * cip
-
-                   snenn = sk_p(k,j,i-1) - sk_p(k,j,i+1)
-                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
-                   sterm = ( sk_p(k,j,i) - sk_p(k,j,i+1) ) / snenn
-                   sterm = MIN( sterm, 0.9999_wp )
-                   sterm = MAX( sterm, 0.0001_wp )
-
-                   ix = INT( sterm * 1000 ) + 1
-
-                   cim = -MIN( 0.0_wp, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
-
-                   imme(k,i) = sk_p(k,j,i+1) * cim + snenn * (                    &
-                               aex(ix) * cim + bex(ix) / dex(ix) * (              &
-                               eex(ix) -                                          &
-                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cim ) )  &
-                                                                   )              &
-                                                             )
-                   IF ( sterm == 0.0001_wp )  imme(k,i) = sk_p(k,j,i) * cim
-                   IF ( sterm == 0.9999_wp )  imme(k,i) = sk_p(k,j,i) * cim
-                ENDIF
-
-!--             *VOCL STMT,IF(10)
-                IF ( sw(k,i+1) == 1.0_wp )  THEN
-                   snenn = sk_p(k,j,i) - sk_p(k,j,i+2)
-                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
-                   sterm = ( sk_p(k,j,i+1) - sk_p(k,j,i+2) ) / snenn
-                   sterm = MIN( sterm, 0.9999_wp )
-                   sterm = MAX( sterm, 0.0001_wp )
-
-                   ix = INT( sterm * 1000 ) + 1
-
-                   cim = -MIN( 0.0_wp, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
-
-                   impe(k,i) = sk_p(k,j,i+2) * cim + snenn * (                    &
-                               aex(ix) * cim + bex(ix) / dex(ix) * (              &
-                               eex(ix) -                                          &
-                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cim ) )  &
-                                                                   )              &
-                                                             )
-                   IF ( sterm == 0.0001_wp )  impe(k,i) = sk_p(k,j,i+1) * cim
-                   IF ( sterm == 0.9999_wp )  impe(k,i) = sk_p(k,j,i+1) * cim
-                ENDIF
-
-!--             *VOCL STMT,IF(10)
-                IF ( sw(k,i-1) == 1.0_wp )  THEN
-                   snenn = sk_p(k,j,i) - sk_p(k,j,i-2)
-                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
-                   sterm = ( sk_p(k,j,i-1) - sk_p(k,j,i-2) ) / snenn
-                   sterm = MIN( sterm, 0.9999_wp )
-                   sterm = MAX( sterm, 0.0001_wp )
-
-                   ix = INT( sterm * 1000 ) + 1
-
-                   cip = MAX( 0.0_wp, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
-
-                   ipme(k,i) = sk_p(k,j,i-2) * cip + snenn * (                    &
-                               aex(ix) * cip + bex(ix) / dex(ix) * (              &
-                               eex(ix) -                                          &
-                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cip ) )  &
-                                                                   )              &
-                                                             )
-                   IF ( sterm == 0.0001_wp )  ipme(k,i) = sk_p(k,j,i-1) * cip
-                   IF ( sterm == 0.9999_wp )  ipme(k,i) = sk_p(k,j,i-1) * cip
-                ENDIF
-
-             ENDDO
-          ENDDO
-          CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'pause' )
-
-!
-!--       Prognostic equation
-          DO  i = nxl, nxr
-             DO  k = nzb+1, nzt
-                fplus  = ( 1.0_wp - sw(k,i)   ) * ippb(k,i) + sw(k,i)   * ippe(k,i)  &
-                       - ( 1.0_wp - sw(k,i+1) ) * impb(k,i) - sw(k,i+1) * impe(k,i)
-                fminus = ( 1.0_wp - sw(k,i-1) ) * ipmb(k,i) + sw(k,i-1) * ipme(k,i)  &
-                       - ( 1.0_wp - sw(k,i)   ) * immb(k,i) - sw(k,i)   * imme(k,i)
-                tendcy = fplus - fminus
-!
-!--             Removed in order to optimize speed
-!                ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35_wp )
-!                IF ( ( ABS( tendcy ) / ffmax ) < 1E-7_wp )  tendcy = 0.0
-!
-!--             Density correction because of possible remaining divergences
-                d_new = d(k,j,i) - ( u(k,j,i+1) - u(k,j,i) ) * dt_3d * ddx
-                sk_p(k,j,i) = ( ( 1.0_wp + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) /    &
-                              ( 1.0_wp + d_new )
-                d(k,j,i)  = d_new
-             ENDDO
-          ENDDO
-
-       ENDDO   ! End of the advection in x-direction
-
-!
-!--    Deallocate temporary arrays
-       DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme,      &
-                   ippb, ippe, m1, sw )
-
-
-!
-!--    Enlarge boundary of local array cyclically in y-direction
-#if defined( __parallel )
-       ngp = ( nzt - nzb + 6 ) * ( nyn - nys + 7 )
-       CALL MPI_TYPE_VECTOR( nxr-nxl+7, 3*(nzt-nzb+6), ngp, MPI_REAL,             &
-                             type_xz_2, ierr )
-       CALL MPI_TYPE_COMMIT( type_xz_2, ierr )
-!
-!--    Send front boundary, receive rear boundary
-       CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'continue' )
-       CALL MPI_SENDRECV( sk_p(nzb-2,nys,nxl-3),   1, type_xz_2, psouth, 0,       &
-                          sk_p(nzb-2,nyn+1,nxl-3), 1, type_xz_2, pnorth, 0,       &
-                          comm2d, status, ierr )
-!
-!--    Send rear boundary, receive front boundary
-       CALL MPI_SENDRECV( sk_p(nzb-2,nyn-2,nxl-3), 1, type_xz_2, pnorth, 1,       &
-                          sk_p(nzb-2,nys-3,nxl-3), 1, type_xz_2, psouth, 1,       &
-                          comm2d, status, ierr )
-       CALL MPI_TYPE_FREE( type_xz_2, ierr )
-       CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'pause' )
-#else
-       DO  i = nxl, nxr
-          DO  k = nzb+1, nzt
-             sk_p(k,nys-1,i) = sk_p(k,nyn,i)
-             sk_p(k,nys-2,i) = sk_p(k,nyn-1,i)
-             sk_p(k,nys-3,i) = sk_p(k,nyn-2,i)
-             sk_p(k,nyn+1,i) = sk_p(k,nys,i)
-             sk_p(k,nyn+2,i) = sk_p(k,nys+1,i)
-             sk_p(k,nyn+3,i) = sk_p(k,nys+2,i)
-          ENDDO
-       ENDDO
-#endif
-
-!
-!--    Determine the maxima of the first and second derivative in y-direction
-       fmax_l = 0.0_wp
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                numera = ABS( sk_p(k,j+1,i) - 2.0_wp * sk_p(k,j,i) + sk_p(k,j-1,i) )
-                denomi  = ABS( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
-                fmax_l(1) = MAX( fmax_l(1) , numera )
-                fmax_l(2) = MAX( fmax_l(2) , denomi  )
-             ENDDO
-          ENDDO
-       ENDDO
-#if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( fmax_l, fmax, 2, MPI_REAL, MPI_MAX, comm2d, ierr )
-#else
-       fmax = fmax_l
-#endif
-
-       fmax = 0.04_wp * fmax
-
-!
-!--    Allocate temporary arrays
-       ALLOCATE( a0(nzb+1:nzt,nys-1:nyn+1),   a1(nzb+1:nzt,nys-1:nyn+1),          &
-                 a2(nzb+1:nzt,nys-1:nyn+1),   a12(nzb+1:nzt,nys-1:nyn+1),         &
-                 a22(nzb+1:nzt,nys-1:nyn+1),  immb(nzb+1:nzt,nys-1:nyn+1),        &
-                 imme(nzb+1:nzt,nys-1:nyn+1), impb(nzb+1:nzt,nys-1:nyn+1),        &
-                 impe(nzb+1:nzt,nys-1:nyn+1), ipmb(nzb+1:nzt,nys-1:nyn+1),        &
-                 ipme(nzb+1:nzt,nys-1:nyn+1), ippb(nzb+1:nzt,nys-1:nyn+1),        &
-                 ippe(nzb+1:nzt,nys-1:nyn+1), m1(nzb+1:nzt,nys-2:nyn+2),          &
-                 sw(nzb+1:nzt,nys-1:nyn+1)                                        &
-               )
-       imme = 0.0_wp; impe = 0.0_wp; ipme = 0.0_wp; ippe = 0.0_wp
-
-!
-!--    Outer loop of all i
-       DO  i = nxl, nxr
-
-!
-!--       Compute polynomial coefficients
-          DO  j = nys-1, nyn+1
-             DO  k = nzb+1, nzt
-                a12(k,j) = 0.5_wp * ( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
-                a22(k,j) = 0.5_wp * ( sk_p(k,j+1,i) - 2.0_wp * sk_p(k,j,i)        &
-                                                    + sk_p(k,j-1,i) )
-                a0(k,j) = ( 9.0_wp * sk_p(k,j+2,i)    - 116.0_wp * sk_p(k,j+1,i)  &
-                            + 2134.0_wp * sk_p(k,j,i) - 116.0_wp * sk_p(k,j-1,i)  &
-                            + 9.0_wp * sk_p(k,j-2,i) ) * f1920
-                a1(k,j) = ( -5.0_wp   * sk_p(k,j+2,i) + 34.0_wp * sk_p(k,j+1,i)   &
-                            - 34.0_wp * sk_p(k,j-1,i) + 5.0_wp  * sk_p(k,j-2,i)   &
-                          ) * f48
-                a2(k,j) = ( -3.0_wp * sk_p(k,j+2,i) + 36.0_wp * sk_p(k,j+1,i)     &
-                            - 66.0_wp * sk_p(k,j,i) + 36.0_wp * sk_p(k,j-1,i)     &
-                            - 3.0_wp * sk_p(k,j-2,i) ) * f48
-             ENDDO
-          ENDDO
-
-!
-!--       Fluxes using the Bott scheme
-!--       *VOCL LOOP,UNROLL(2)
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                cip  =  MAX( 0.0_wp, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
-                cim  = -MIN( 0.0_wp, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
-                cipf = 1.0_wp - 2.0_wp * cip
-                cimf = 1.0_wp - 2.0_wp * cim
-                ip   =   a0(k,j)   * f2  * ( 1.0_wp - cipf )                      &
-                       + a1(k,j)   * f8  * ( 1.0_wp - cipf*cipf )                 &
-                       + a2(k,j)   * f24 * ( 1.0_wp - cipf*cipf*cipf )
-                im   =   a0(k,j+1) * f2  * ( 1.0_wp - cimf )                      &
-                       - a1(k,j+1) * f8  * ( 1.0_wp - cimf*cimf )                 &
-                       + a2(k,j+1) * f24 * ( 1.0_wp - cimf*cimf*cimf )
-                ip   = MAX( ip, 0.0_wp )
-                im   = MAX( im, 0.0_wp )
-                ippb(k,j) = ip * MIN( 1.0_wp, sk_p(k,j,i)   / (ip+im+1E-15_wp) )
-                impb(k,j) = im * MIN( 1.0_wp, sk_p(k,j+1,i) / (ip+im+1E-15_wp) )
-
-                cip  =  MAX( 0.0_wp, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
-                cim  = -MIN( 0.0_wp, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
-                cipf = 1.0_wp - 2.0_wp * cip
-                cimf = 1.0_wp - 2.0_wp * cim
-                ip   =   a0(k,j-1) * f2  * ( 1.0_wp - cipf )                      &
-                       + a1(k,j-1) * f8  * ( 1.0_wp - cipf*cipf )                 &
-                       + a2(k,j-1) * f24 * ( 1.0_wp - cipf*cipf*cipf )
-                im   =   a0(k,j)   * f2  * ( 1.0_wp - cimf )                      &
-                       - a1(k,j)   * f8  * ( 1.0_wp - cimf*cimf )                 &
-                       + a2(k,j)   * f24 * ( 1.0_wp - cimf*cimf*cimf )
-                ip   = MAX( ip, 0.0_wp )
-                im   = MAX( im, 0.0_wp )
-                ipmb(k,j) = ip * MIN( 1.0_wp, sk_p(k,j-1,i) / (ip+im+1E-15_wp) )
-                immb(k,j) = im * MIN( 1.0_wp, sk_p(k,j,i)   / (ip+im+1E-15_wp) )
-             ENDDO
-          ENDDO
-
-!
-!--       Compute monitor function m1
-          DO  j = nys-2, nyn+2
-             DO  k = nzb+1, nzt
-                m1z = ABS( sk_p(k,j+1,i) - 2.0_wp * sk_p(k,j,i) + sk_p(k,j-1,i) )
-                m1n = ABS( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
-                IF ( m1n /= 0.0_wp  .AND.  m1n >= m1z )  THEN
-                   m1(k,j) = m1z / m1n
-                   IF ( m1(k,j) /= 2.0_wp  .AND.  m1n < fmax(2) )  m1(k,j) = 0.0_wp
-                ELSEIF ( m1n < m1z )  THEN
-                   m1(k,j) = -1.0_wp
-                ELSE
-                   m1(k,j) = 0.0_wp
-                ENDIF
-             ENDDO
-          ENDDO
-
-!
-!--       Compute switch sw
-          sw = 0.0_wp
-          DO  j = nys-1, nyn+1
-             DO  k = nzb+1, nzt
-                m2 = 2.0_wp * ABS( a1(k,j) - a12(k,j) ) /                            &
-                     MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35_wp )
-                IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) )  m2 = 0.0_wp
-
-                m3 = 2.0_wp * ABS( a2(k,j) - a22(k,j) ) /                            &
-                     MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35_wp )
-                IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) )  m3 = 0.0_wp
-
-                t1 = 0.35_wp
-                t2 = 0.35_wp
-                IF ( m1(k,j) == -1.0_wp )  t2 = 0.12_wp
-
-!--             *VOCL STMT,IF(10)
-                IF ( m1(k,j-1) == 1.0_wp .OR. m1(k,j) == 1.0_wp                   &
-                     .OR. m1(k,j+1) == 1.0_wp .OR.  m2 > t2  .OR.  m3 > t2  .OR.  &
-                     ( m1(k,j) > t1  .AND.  m1(k,j-1) /= -1.0_wp  .AND.           &
-                       m1(k,j) /= -1.0_wp  .AND.  m1(k,j+1) /= -1.0_wp )          &
-                   )  sw(k,j) = 1.0_wp
-             ENDDO
-          ENDDO
-
-!
-!--       Fluxes using exponential scheme
-          CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'continue' )
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-
-!--             *VOCL STMT,IF(10)
-                IF ( sw(k,j) == 1.0_wp )  THEN
-                   snenn = sk_p(k,j+1,i) - sk_p(k,j-1,i)
-                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
-                   sterm = ( sk_p(k,j,i) - sk_p(k,j-1,i) ) / snenn
-                   sterm = MIN( sterm, 0.9999_wp )
-                   sterm = MAX( sterm, 0.0001_wp )
-
-                   ix = INT( sterm * 1000 ) + 1
-
-                   cip =  MAX( 0.0_wp, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
-
-                   ippe(k,j) = sk_p(k,j-1,i) * cip + snenn * (                    &
-                               aex(ix) * cip + bex(ix) / dex(ix) * (              &
-                               eex(ix) -                                          &
-                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cip ) )  &
-                                                                   )              &
-                                                             )
-                   IF ( sterm == 0.0001_wp )  ippe(k,j) = sk_p(k,j,i) * cip
-                   IF ( sterm == 0.9999_wp )  ippe(k,j) = sk_p(k,j,i) * cip
-
-                   snenn = sk_p(k,j-1,i) - sk_p(k,j+1,i)
-                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
-                   sterm = ( sk_p(k,j,i) - sk_p(k,j+1,i) ) / snenn
-                   sterm = MIN( sterm, 0.9999_wp )
-                   sterm = MAX( sterm, 0.0001_wp )
-
-                   ix = INT( sterm * 1000 ) + 1
-
-                   cim = -MIN( 0.0_wp, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
-
-                   imme(k,j) = sk_p(k,j+1,i) * cim + snenn * (                    &
-                               aex(ix) * cim + bex(ix) / dex(ix) * (              &
-                               eex(ix) -                                          &
-                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cim ) )  &
-                                                                   )              &
-                                                             )
-                   IF ( sterm == 0.0001_wp )  imme(k,j) = sk_p(k,j,i) * cim
-                   IF ( sterm == 0.9999_wp )  imme(k,j) = sk_p(k,j,i) * cim
-                ENDIF
-
-!--             *VOCL STMT,IF(10)
-                IF ( sw(k,j+1) == 1.0_wp )  THEN
-                   snenn = sk_p(k,j,i) - sk_p(k,j+2,i)
-                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
-                   sterm = ( sk_p(k,j+1,i) - sk_p(k,j+2,i) ) / snenn
-                   sterm = MIN( sterm, 0.9999_wp )
-                   sterm = MAX( sterm, 0.0001_wp )
-
-                   ix = INT( sterm * 1000 ) + 1
-
-                   cim = -MIN( 0.0_wp, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
-
-                   impe(k,j) = sk_p(k,j+2,i) * cim + snenn * (                    &
-                               aex(ix) * cim + bex(ix) / dex(ix) * (              &
-                               eex(ix) -                                          &
-                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cim ) )  &
-                                                                   )              &
-                                                             )
-                   IF ( sterm == 0.0001_wp )  impe(k,j) = sk_p(k,j+1,i) * cim
-                   IF ( sterm == 0.9999_wp )  impe(k,j) = sk_p(k,j+1,i) * cim
-                ENDIF
-
-!--             *VOCL STMT,IF(10)
-                IF ( sw(k,j-1) == 1.0_wp )  THEN
-                   snenn = sk_p(k,j,i) - sk_p(k,j-2,i)
-                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
-                   sterm = ( sk_p(k,j-1,i) - sk_p(k,j-2,i) ) / snenn
-                   sterm = MIN( sterm, 0.9999_wp )
-                   sterm = MAX( sterm, 0.0001_wp )
-
-                   ix = INT( sterm * 1000 ) + 1
-
-                   cip = MAX( 0.0_wp, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
-
-                   ipme(k,j) = sk_p(k,j-2,i) * cip + snenn * (                    &
-                               aex(ix) * cip + bex(ix) / dex(ix) * (              &
-                               eex(ix) -                                          &
-                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cip ) )  &
-                                                                   )              &
-                                                             )
-                   IF ( sterm == 0.0001_wp )  ipme(k,j) = sk_p(k,j-1,i) * cip
-                   IF ( sterm == 0.9999_wp )  ipme(k,j) = sk_p(k,j-1,i) * cip
-                ENDIF
-
-             ENDDO
-          ENDDO
-          CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'pause' )
-
-!
-!--       Prognostic equation
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                fplus  = ( 1.0_wp - sw(k,j)   ) * ippb(k,j) + sw(k,j)   * ippe(k,j) &
-                       - ( 1.0_wp - sw(k,j+1) ) * impb(k,j) - sw(k,j+1) * impe(k,j)
-                fminus = ( 1.0_wp - sw(k,j-1) ) * ipmb(k,j) + sw(k,j-1) * ipme(k,j) &
-                       - ( 1.0_wp - sw(k,j)   ) * immb(k,j) - sw(k,j)   * imme(k,j)
-                tendcy = fplus - fminus
-!
-!--             Removed in order to optimise speed
-!                ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35_wp )
-!                 IF ( ( ABS( tendcy ) / ffmax ) < 1E-7_wp )  tendcy = 0.0
-!
-!--             Density correction because of possible remaining divergences
-                d_new = d(k,j,i) - ( v(k,j+1,i) - v(k,j,i) ) * dt_3d * ddy
-                sk_p(k,j,i) = ( ( 1.0_wp + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) /  &
-                              ( 1.0_wp + d_new )
-                d(k,j,i)  = d_new
-             ENDDO
-          ENDDO
-
-       ENDDO   ! End of the advection in y-direction
-       CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'continue' )
-       CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'stop' )
-
-!
-!--    Deallocate temporary arrays
-       DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme,      &
-                   ippb, ippe, m1, sw )
-
-
-!
-!--    Initialise for the computation of heat fluxes (see below; required in
-!--    UP flow_statistics)
-       IF ( sk_char == 'pt' )  sums_wsts_bc_l = 0.0_wp
-
-!
-!--    Add top and bottom boundaries according to the relevant boundary conditions
-       IF ( sk_char == 'pt' )  THEN
-
-!
-!--       Temperature boundary condition at the bottom boundary
-          IF ( ibc_pt_b == 0 )  THEN
-!
-!--       Dirichlet (fixed surface temperature)
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
-                   sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
-                ENDDO
-             ENDDO
-
-          ELSE
-!
-!--          Neumann (i.e. here zero gradient)
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
-                   sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
-                   sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
-                ENDDO
-             ENDDO
-
-          ENDIF
-
-!
-!--       Temperature boundary condition at the top boundary
-          IF ( ibc_pt_t == 0  .OR.  ibc_pt_t == 1 )  THEN
-!
-!--          Dirichlet or Neumann (zero gradient)
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i)
-                   sk_p(nzt+3,j,i)   = sk_p(nzt+1,j,i)
-                ENDDO
-             ENDDO
-
-          ELSEIF ( ibc_pt_t == 2 )  THEN
-!
-!--          Neumann: dzu(nzt+2:3) are not defined, dzu(nzt+1) is used instead
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i) + bc_pt_t_val * dzu(nzt+1)
-                   sk_p(nzt+3,j,i)   = sk_p(nzt+2,j,i) + bc_pt_t_val * dzu(nzt+1)
-                ENDDO
-             ENDDO
-
-          ENDIF
-
-       ELSEIF ( sk_char == 'sa' )  THEN
-
-!
-!--       Salinity boundary condition at the bottom boundary.
-!--       So far, always Neumann (i.e. here zero gradient) is used
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
-                sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
-                sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
-             ENDDO
-          ENDDO
-
-!
-!--       Salinity boundary condition at the top boundary.
-!--       Dirichlet or Neumann (zero gradient)
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i)
-                sk_p(nzt+3,j,i)   = sk_p(nzt+1,j,i)
-             ENDDO
-          ENDDO
-
-       ELSEIF ( sk_char == 'q' )  THEN
-
-!
-!--       Specific humidity boundary condition at the bottom boundary.
-!--       Dirichlet (fixed surface humidity) or Neumann (i.e. zero gradient)
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
-                sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
-                sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
-             ENDDO
-          ENDDO
-
-!
-!--       Specific humidity boundary condition at the top boundary
-          IF ( ibc_q_t == 0 )  THEN
-!
-!--          Dirichlet
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i)
-                   sk_p(nzt+3,j,i)   = sk_p(nzt+1,j,i)
-                ENDDO
-             ENDDO
-
-          ELSE
-!
-!--          Neumann: dzu(nzt+2:3) are not defined, dzu(nzt+1) is used instead
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i) + bc_q_t_val * dzu(nzt+1)
-                   sk_p(nzt+3,j,i)   = sk_p(nzt+2,j,i) + bc_q_t_val * dzu(nzt+1)
-                ENDDO
-             ENDDO
-
-          ENDIF
-
-       ELSEIF ( sk_char == 'qr' )  THEN
-
-!
-!--       Rain water content boundary condition at the bottom boundary:
-!--       Dirichlet (fixed surface rain water content).
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
-                sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
-                sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
-             ENDDO
-          ENDDO
-
-!
-!--       Rain water content boundary condition at the top boundary: Dirichlet
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i)
-                sk_p(nzt+3,j,i)   = sk_p(nzt+1,j,i)
-             ENDDO
-          ENDDO
-
-       ELSEIF ( sk_char == 'nr' )  THEN
-
-!
-!--       Rain drop concentration boundary condition at the bottom boundary:
-!--       Dirichlet (fixed surface rain drop concentration).
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
-                sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
-                sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
-             ENDDO
-          ENDDO
-
-!
-!--       Rain drop concentration boundary condition at the top boundary: Dirichlet
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                sk_p(nzt+2,j,i)   = sk_p(nzt+1,j,i)
-                sk_p(nzt+3,j,i)   = sk_p(nzt+1,j,i)
-             ENDDO
-          ENDDO
-
-       ELSEIF ( sk_char == 'e' )  THEN
-
-!
-!--       TKE boundary condition at bottom and top boundary (generally Neumann)
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                sk_p(nzb,j,i)   = sk_p(nzb+1,j,i)
-                sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
-                sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
-                sk_p(nzt+2,j,i) = sk_p(nzt+1,j,i)
-                sk_p(nzt+3,j,i) = sk_p(nzt+1,j,i)
-             ENDDO
-          ENDDO
-
-       ELSE
-
-          WRITE( message_string, * ) 'no vertical boundary condi',                &
-                                   'tion for variable "', sk_char, '"'
-          CALL message( 'advec_s_bc', 'PA0158', 1, 2, 0, 6, 0 )
-         
-       ENDIF
-
-!
-!--    Determine the maxima of the first and second derivative in z-direction
-       fmax_l = 0.0_wp
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb, nzt+1
-                numera = ABS( sk_p(k+1,j,i) - 2.0_wp * sk_p(k,j,i) + sk_p(k-1,j,i) )
-                denomi  = ABS( sk_p(k+1,j,i+1) - sk_p(k-1,j,i) )
-                fmax_l(1) = MAX( fmax_l(1) , numera )
-                fmax_l(2) = MAX( fmax_l(2) , denomi  )
-             ENDDO
-          ENDDO
-       ENDDO
-#if defined( __parallel )
-       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( fmax_l, fmax, 2, MPI_REAL, MPI_MAX, comm2d, ierr )
-#else
-       fmax = fmax_l
-#endif
-
-       fmax = 0.04_wp * fmax
-
-!
-!--    Allocate temporary arrays
-       ALLOCATE( a0(nzb:nzt+1,nys:nyn),   a1(nzb:nzt+1,nys:nyn),                  &
-                 a2(nzb:nzt+1,nys:nyn),   a12(nzb:nzt+1,nys:nyn),                 &
-                 a22(nzb:nzt+1,nys:nyn),  immb(nzb+1:nzt,nys:nyn),                &
-                 imme(nzb+1:nzt,nys:nyn), impb(nzb+1:nzt,nys:nyn),                &
-                 impe(nzb+1:nzt,nys:nyn), ipmb(nzb+1:nzt,nys:nyn),                &
-                 ipme(nzb+1:nzt,nys:nyn), ippb(nzb+1:nzt,nys:nyn),                &
-                 ippe(nzb+1:nzt,nys:nyn), m1(nzb-1:nzt+2,nys:nyn),                &
-                 sw(nzb:nzt+1,nys:nyn)                                            &
-               )
-       imme = 0.0_wp; impe = 0.0_wp; ipme = 0.0_wp; ippe = 0.0_wp
-
-!
-!--    Outer loop of all i
-       DO  i = nxl, nxr
-
-!
-!--       Compute polynomial coefficients
-          DO  j = nys, nyn
-             DO  k = nzb, nzt+1
-                a12(k,j) = 0.5_wp * ( sk_p(k+1,j,i) - sk_p(k-1,j,i) )
-                a22(k,j) = 0.5_wp * ( sk_p(k+1,j,i) - 2.0_wp * sk_p(k,j,i)        &
-                                                    + sk_p(k-1,j,i) )
-                a0(k,j) = ( 9.0_wp * sk_p(k+2,j,i)    - 116.0_wp * sk_p(k+1,j,i)  &
-                            + 2134.0_wp * sk_p(k,j,i) - 116.0_wp * sk_p(k-1,j,i)  &
-                            + 9.0_wp * sk_p(k-2,j,i) ) * f1920
-                a1(k,j) = ( -5.0_wp   * sk_p(k+2,j,i) + 34.0_wp * sk_p(k+1,j,i)   &
-                            - 34.0_wp * sk_p(k-1,j,i) + 5.0_wp  * sk_p(k-2,j,i)   &
-                          ) * f48
-                a2(k,j) = ( -3.0_wp * sk_p(k+2,j,i) + 36.0_wp * sk_p(k+1,j,i)     &
-                            - 66.0_wp * sk_p(k,j,i) + 36.0_wp * sk_p(k-1,j,i)     &
-                            - 3.0_wp * sk_p(k-2,j,i) ) * f48
-             ENDDO
-          ENDDO
-
-!
-!--       Fluxes using the Bott scheme
-!--       *VOCL LOOP,UNROLL(2)
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                cip  =  MAX( 0.0_wp, w(k,j,i) * dt_3d * ddzw(k) )
-                cim  = -MIN( 0.0_wp, w(k,j,i) * dt_3d * ddzw(k) )
-                cipf = 1.0_wp - 2.0_wp * cip
-                cimf = 1.0_wp - 2.0_wp * cim
-                ip   =   a0(k,j)   * f2  * ( 1.0_wp - cipf )                      &
-                       + a1(k,j)   * f8  * ( 1.0_wp - cipf*cipf )                 &
-                       + a2(k,j)   * f24 * ( 1.0_wp - cipf*cipf*cipf )
-                im   =   a0(k+1,j) * f2  * ( 1.0_wp - cimf )                      &
-                       - a1(k+1,j) * f8  * ( 1.0_wp - cimf*cimf )                 &
-                       + a2(k+1,j) * f24 * ( 1.0_wp - cimf*cimf*cimf )
-                ip   = MAX( ip, 0.0_wp )
-                im   = MAX( im, 0.0_wp )
-                ippb(k,j) = ip * MIN( 1.0_wp, sk_p(k,j,i)   / (ip+im+1E-15_wp) )
-                impb(k,j) = im * MIN( 1.0_wp, sk_p(k+1,j,i) / (ip+im+1E-15_wp) )
-
-                cip  =  MAX( 0.0_wp, w(k-1,j,i) * dt_3d * ddzw(k) )
-                cim  = -MIN( 0.0_wp, w(k-1,j,i) * dt_3d * ddzw(k) )
-                cipf = 1.0_wp - 2.0_wp * cip
-                cimf = 1.0_wp - 2.0_wp * cim
-                ip   =   a0(k-1,j) * f2  * ( 1.0_wp - cipf )                      &
-                       + a1(k-1,j) * f8  * ( 1.0_wp - cipf*cipf )                 &
-                       + a2(k-1,j) * f24 * ( 1.0_wp - cipf*cipf*cipf )
-                im   =   a0(k,j)   * f2  * ( 1.0_wp - cimf )                      &
-                       - a1(k,j)   * f8  * ( 1.0_wp - cimf*cimf )                 &
-                       + a2(k,j)   * f24 * ( 1.0_wp - cimf*cimf*cimf )
-                ip   = MAX( ip, 0.0_wp )
-                im   = MAX( im, 0.0_wp )
-                ipmb(k,j) = ip * MIN( 1.0_wp, sk_p(k-1,j,i) / (ip+im+1E-15_wp) )
-                immb(k,j) = im * MIN( 1.0_wp, sk_p(k,j,i)   / (ip+im+1E-15_wp) )
-             ENDDO
-          ENDDO
-
-!
-!--       Compute monitor function m1
-          DO  j = nys, nyn
-             DO  k = nzb-1, nzt+2
-                m1z = ABS( sk_p(k+1,j,i) - 2.0_wp * sk_p(k,j,i) + sk_p(k-1,j,i) )
-                m1n = ABS( sk_p(k+1,j,i) - sk_p(k-1,j,i) )
-                IF ( m1n /= 0.0_wp  .AND.  m1n >= m1z )  THEN
-                   m1(k,j) = m1z / m1n
-                   IF ( m1(k,j) /= 2.0_wp  .AND.  m1n < fmax(2) )  m1(k,j) = 0.0_wp
-                ELSEIF ( m1n < m1z )  THEN
-                   m1(k,j) = -1.0_wp
-                ELSE
-                   m1(k,j) = 0.0_wp
-                ENDIF
-             ENDDO
-          ENDDO
-
-!
-!--       Compute switch sw
-          sw = 0.0_wp
-          DO  j = nys, nyn
-             DO  k = nzb, nzt+1
-                m2 = 2.0_wp * ABS( a1(k,j) - a12(k,j) ) /                         &
-                     MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35_wp )
-                IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) )  m2 = 0.0_wp
-
-                m3 = 2.0_wp * ABS( a2(k,j) - a22(k,j) ) /                         &
-                     MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35_wp )
-                IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) )  m3 = 0.0_wp
-
-                t1 = 0.35_wp
-                t2 = 0.35_wp
-                IF ( m1(k,j) == -1.0_wp )  t2 = 0.12_wp
-
-!--             *VOCL STMT,IF(10)
-                IF ( m1(k-1,j) == 1.0_wp .OR. m1(k,j) == 1.0_wp                   &
-                     .OR. m1(k+1,j) == 1.0_wp .OR.  m2 > t2  .OR.  m3 > t2  .OR.  &
-                     ( m1(k,j) > t1  .AND.  m1(k-1,j) /= -1.0_wp  .AND.           &
-                       m1(k,j) /= -1.0_wp  .AND.  m1(k+1,j) /= -1.0_wp )          &
-                   )  sw(k,j) = 1.0_wp
-             ENDDO
-          ENDDO
-
-!
-!--       Fluxes using exponential scheme
-          CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'continue' )
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-
-!--             *VOCL STMT,IF(10)
-                IF ( sw(k,j) == 1.0_wp )  THEN
-                   snenn = sk_p(k+1,j,i) - sk_p(k-1,j,i)
-                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
-                   sterm = ( sk_p(k,j,i) - sk_p(k-1,j,i) ) / snenn
-                   sterm = MIN( sterm, 0.9999_wp )
-                   sterm = MAX( sterm, 0.0001_wp )
-
-                   ix = INT( sterm * 1000 ) + 1
-
-                   cip =  MAX( 0.0_wp, w(k,j,i) * dt_3d * ddzw(k) )
-
-                   ippe(k,j) = sk_p(k-1,j,i) * cip + snenn * (                    &
-                               aex(ix) * cip + bex(ix) / dex(ix) * (              &
-                               eex(ix) -                                          &
-                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cip ) )  &
-                                                                   )              &
-                                                             )
-                   IF ( sterm == 0.0001_wp )  ippe(k,j) = sk_p(k,j,i) * cip
-                   IF ( sterm == 0.9999_wp )  ippe(k,j) = sk_p(k,j,i) * cip
-
-                   snenn = sk_p(k-1,j,i) - sk_p(k+1,j,i)
-                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
-                   sterm = ( sk_p(k,j,i) - sk_p(k+1,j,i) ) / snenn
-                   sterm = MIN( sterm, 0.9999_wp )
-                   sterm = MAX( sterm, 0.0001_wp )
-
-                   ix = INT( sterm * 1000 ) + 1
-
-                   cim = -MIN( 0.0_wp, w(k-1,j,i) * dt_3d * ddzw(k) )
-
-                   imme(k,j) = sk_p(k+1,j,i) * cim + snenn * (                    &
-                               aex(ix) * cim + bex(ix) / dex(ix) * (              &
-                               eex(ix) -                                          &
-                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cim ) ) &
-                                                                   )              &
-                                                             )
-                   IF ( sterm == 0.0001_wp )  imme(k,j) = sk_p(k,j,i) * cim
-                   IF ( sterm == 0.9999_wp )  imme(k,j) = sk_p(k,j,i) * cim
-                ENDIF
-
-!--             *VOCL STMT,IF(10)
-                IF ( sw(k+1,j) == 1.0_wp )  THEN
-                   snenn = sk_p(k,j,i) - sk_p(k+2,j,i)
-                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
-                   sterm = ( sk_p(k+1,j,i) - sk_p(k+2,j,i) ) / snenn
-                   sterm = MIN( sterm, 0.9999_wp )
-                   sterm = MAX( sterm, 0.0001_wp )
-
-                   ix = INT( sterm * 1000 ) + 1
-
-                   cim = -MIN( 0.0_wp, w(k,j,i) * dt_3d * ddzw(k) )
-
-                   impe(k,j) = sk_p(k+2,j,i) * cim + snenn * (                    &
-                               aex(ix) * cim + bex(ix) / dex(ix) * (              &
-                               eex(ix) -                                          &
-                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cim ) )  &
-                                                                   )              &
-                                                             )
-                   IF ( sterm == 0.0001_wp )  impe(k,j) = sk_p(k+1,j,i) * cim
-                   IF ( sterm == 0.9999_wp )  impe(k,j) = sk_p(k+1,j,i) * cim
-                ENDIF
-
-!--             *VOCL STMT,IF(10)
-                IF ( sw(k-1,j) == 1.0_wp )  THEN
-                   snenn = sk_p(k,j,i) - sk_p(k-2,j,i)
-                   IF ( ABS( snenn ) < 1E-9_wp )  snenn = 1E-9_wp
-                   sterm = ( sk_p(k-1,j,i) - sk_p(k-2,j,i) ) / snenn
-                   sterm = MIN( sterm, 0.9999_wp )
-                   sterm = MAX( sterm, 0.0001_wp )
-
-                   ix = INT( sterm * 1000 ) + 1
-
-                   cip = MAX( 0.0_wp, w(k-1,j,i) * dt_3d * ddzw(k) )
-
-                   ipme(k,j) = sk_p(k-2,j,i) * cip + snenn * (                    &
-                               aex(ix) * cip + bex(ix) / dex(ix) * (              &
-                               eex(ix) -                                          &
-                               EXP( dex(ix)*0.5_wp * ( 1.0_wp - 2.0_wp * cip ) )  &
-                                                                   )              &
-                                                             )
-                   IF ( sterm == 0.0001_wp )  ipme(k,j) = sk_p(k-1,j,i) * cip
-                   IF ( sterm == 0.9999_wp )  ipme(k,j) = sk_p(k-1,j,i) * cip
-                ENDIF
-
-             ENDDO
-          ENDDO
-          CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'pause' )
-
-!
-!--       Prognostic equation
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                fplus  = ( 1.0_wp - sw(k,j)   ) * ippb(k,j) + sw(k,j)   * ippe(k,j) &
-                       - ( 1.0_wp - sw(k+1,j) ) * impb(k,j) - sw(k+1,j) * impe(k,j)
-                fminus = ( 1.0_wp - sw(k-1,j) ) * ipmb(k,j) + sw(k-1,j) * ipme(k,j) &
-                       - ( 1.0_wp - sw(k,j)   ) * immb(k,j) - sw(k,j)   * imme(k,j)
-                tendcy = fplus - fminus
-!
-!--              Removed in order to optimise speed
-!                ffmax   = MAX( ABS( fplus ), ABS( fminus ), 1E-35_wp )
-!                IF ( ( ABS( tendcy ) / ffmax ) < 1E-7_wp )  tendcy = 0.0
-!
-!--             Density correction because of possible remaining divergences
-                d_new = d(k,j,i) - ( w(k,j,i) - w(k-1,j,i) ) * dt_3d * ddzw(k)
-                sk_p(k,j,i) = ( ( 1.0_wp + d(k,j,i) ) * sk_p(k,j,i) - tendcy ) /  &
-                              ( 1.0_wp + d_new )
-!
-!--             Store heat flux for subsequent statistics output.
-!--             array m1 is here used as temporary storage
-                m1(k,j) = fplus / dt_3d * dzw(k)
-             ENDDO
-          ENDDO
-
-!
-!--       Sum up heat flux in order to order to obtain horizontal averages
-          IF ( sk_char == 'pt' )  THEN
-             DO  sr = 0, statistic_regions
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      sums_wsts_bc_l(k,sr) = sums_wsts_bc_l(k,sr) +               &
-                                             m1(k,j) * rmask(j,i,sr)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-
-       ENDDO   ! End of the advection in z-direction
-       CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'continue' )
-       CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'stop' )
-
-!
-!--    Deallocate temporary arrays
-       DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme,      &
-                   ippb, ippe, m1, sw )
-
-!
-!--    Store results as tendency and deallocate local array
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+1, nzt
-                tend(k,j,i) = tend(k,j,i) + ( sk_p(k,j,i) - sk(k,j,i) ) / dt_3d
-             ENDDO
-          ENDDO
-       ENDDO
-
-       DEALLOCATE( sk_p )
-
-    END SUBROUTINE advec_s_bc
-
- END MODULE advec_s_bc_mod
Index: /palm/trunk/SOURCE/advec_s_pw.f90
===================================================================
--- /palm/trunk/SOURCE/advec_s_pw.f90	(revision 1873)
+++ /palm/trunk/SOURCE/advec_s_pw.f90	(revision 1873)
@@ -0,0 +1,188 @@
+!> @file advec_s_pw.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1374 2014-04-25 12:55:07Z raasch
+! missing variables added to ONLY list
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1010 2012-09-20 07:59:54Z raasch
+! cpp switch __nopointer added for pointer free version
+!
+! Revision 1.1  1997/08/29 08:54:20  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Advection term for scalar variables using the Piacsek and Williams scheme
+!> (form C3). Contrary to PW itself, for reasons of accuracy their scheme is
+!> slightly modified as follows: the values of those scalars that are used for
+!> the computation of the flux divergence are reduced by the value of the
+!> relevant scalar at the location where the difference is computed (sk(k,j,i)).
+!> NOTE: at the first grid point above the surface computation still takes place!
+!------------------------------------------------------------------------------!
+ MODULE advec_s_pw_mod
+ 
+
+    PRIVATE
+    PUBLIC advec_s_pw
+
+    INTERFACE advec_s_pw
+       MODULE PROCEDURE advec_s_pw
+       MODULE PROCEDURE advec_s_pw_ij
+    END INTERFACE
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_s_pw( sk )
+
+       USE arrays_3d,                                                          &
+           ONLY:  dd2zu, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
+                  nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
+#endif
+ 
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i)                                      &
+              -0.5_wp * ( ( u(k,j,i+1) - u_gtrans ) * ( sk(k,j,i+1) - sk(k,j,i) ) &
+                        - ( u(k,j,i)   - u_gtrans ) * ( sk(k,j,i-1) - sk(k,j,i) ) &
+                        ) * ddx                                                   &
+              -0.5_wp * ( ( v(k,j+1,i) - v_gtrans ) * ( sk(k,j+1,i) - sk(k,j,i) ) &
+                        - ( v(k,j,i)   - v_gtrans ) * ( sk(k,j-1,i) - sk(k,j,i) ) &
+                        ) * ddy                                                   &
+              -         (   w(k,j,i)                * ( sk(k+1,j,i) - sk(k,j,i) ) &
+                        -   w(k-1,j,i)              * ( sk(k-1,j,i) - sk(k,j,i) ) &
+                        ) * dd2zu(k)
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE advec_s_pw
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_s_pw_ij( i, j, sk )
+
+       USE arrays_3d,                                                          &
+           ONLY:  dd2zu, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
+#endif
+
+
+       DO  k = nzb_s_inner(j,i)+1, nzt
+          tend(k,j,i) = tend(k,j,i)                                            &
+              -0.5_wp * ( ( u(k,j,i+1) - u_gtrans ) * ( sk(k,j,i+1) - sk(k,j,i) ) &
+                        - ( u(k,j,i)   - u_gtrans ) * ( sk(k,j,i-1) - sk(k,j,i) ) &
+                        ) * ddx                                                   &
+              -0.5_wp * ( ( v(k,j+1,i) - v_gtrans ) * ( sk(k,j+1,i) - sk(k,j,i) ) &
+                        - ( v(k,j,i)   - v_gtrans ) * ( sk(k,j-1,i) - sk(k,j,i) ) &
+                        ) * ddy                                                   &
+              -         (   w(k,j,i)                * ( sk(k+1,j,i) - sk(k,j,i) ) &
+                        -   w(k-1,j,i)              * ( sk(k-1,j,i) - sk(k,j,i) ) &
+                        ) * dd2zu(k)
+       ENDDO
+
+    END SUBROUTINE advec_s_pw_ij
+
+ END MODULE advec_s_pw_mod
Index: lm/trunk/SOURCE/advec_s_pw_mod.f90
===================================================================
--- /palm/trunk/SOURCE/advec_s_pw_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,187 +1,0 @@
-!> @file advec_s_pw_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1374 2014-04-25 12:55:07Z raasch
-! missing variables added to ONLY list
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1010 2012-09-20 07:59:54Z raasch
-! cpp switch __nopointer added for pointer free version
-!
-! Revision 1.1  1997/08/29 08:54:20  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Advection term for scalar variables using the Piacsek and Williams scheme
-!> (form C3). Contrary to PW itself, for reasons of accuracy their scheme is
-!> slightly modified as follows: the values of those scalars that are used for
-!> the computation of the flux divergence are reduced by the value of the
-!> relevant scalar at the location where the difference is computed (sk(k,j,i)).
-!> NOTE: at the first grid point above the surface computation still takes place!
-!------------------------------------------------------------------------------!
- MODULE advec_s_pw_mod
- 
-
-    PRIVATE
-    PUBLIC advec_s_pw
-
-    INTERFACE advec_s_pw
-       MODULE PROCEDURE advec_s_pw
-       MODULE PROCEDURE advec_s_pw_ij
-    END INTERFACE
- 
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_s_pw( sk )
-
-       USE arrays_3d,                                                          &
-           ONLY:  dd2zu, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
-                  nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
-#endif
- 
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_s_inner(j,i)+1, nzt
-                tend(k,j,i) = tend(k,j,i)                                      &
-              -0.5_wp * ( ( u(k,j,i+1) - u_gtrans ) * ( sk(k,j,i+1) - sk(k,j,i) ) &
-                        - ( u(k,j,i)   - u_gtrans ) * ( sk(k,j,i-1) - sk(k,j,i) ) &
-                        ) * ddx                                                   &
-              -0.5_wp * ( ( v(k,j+1,i) - v_gtrans ) * ( sk(k,j+1,i) - sk(k,j,i) ) &
-                        - ( v(k,j,i)   - v_gtrans ) * ( sk(k,j-1,i) - sk(k,j,i) ) &
-                        ) * ddy                                                   &
-              -         (   w(k,j,i)                * ( sk(k+1,j,i) - sk(k,j,i) ) &
-                        -   w(k-1,j,i)              * ( sk(k-1,j,i) - sk(k,j,i) ) &
-                        ) * dd2zu(k)
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE advec_s_pw
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_s_pw_ij( i, j, sk )
-
-       USE arrays_3d,                                                          &
-           ONLY:  dd2zu, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
-#endif
-
-
-       DO  k = nzb_s_inner(j,i)+1, nzt
-          tend(k,j,i) = tend(k,j,i)                                            &
-              -0.5_wp * ( ( u(k,j,i+1) - u_gtrans ) * ( sk(k,j,i+1) - sk(k,j,i) ) &
-                        - ( u(k,j,i)   - u_gtrans ) * ( sk(k,j,i-1) - sk(k,j,i) ) &
-                        ) * ddx                                                   &
-              -0.5_wp * ( ( v(k,j+1,i) - v_gtrans ) * ( sk(k,j+1,i) - sk(k,j,i) ) &
-                        - ( v(k,j,i)   - v_gtrans ) * ( sk(k,j-1,i) - sk(k,j,i) ) &
-                        ) * ddy                                                   &
-              -         (   w(k,j,i)                * ( sk(k+1,j,i) - sk(k,j,i) ) &
-                        -   w(k-1,j,i)              * ( sk(k-1,j,i) - sk(k,j,i) ) &
-                        ) * dd2zu(k)
-       ENDDO
-
-    END SUBROUTINE advec_s_pw_ij
-
- END MODULE advec_s_pw_mod
Index: /palm/trunk/SOURCE/advec_s_up.f90
===================================================================
--- /palm/trunk/SOURCE/advec_s_up.f90	(revision 1873)
+++ /palm/trunk/SOURCE/advec_s_up.f90	(revision 1873)
@@ -0,0 +1,237 @@
+!> @file advec_s_up.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1374 2014-04-25 12:55:07Z raasch
+! missing variables added to ONLY list
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1010 2012-09-20 07:59:54Z raasch
+! cpp switch __nopointer added for pointer free version
+!
+! 981 2012-08-09 14:57:44Z maronga
+! Typo removed
+!
+! Revision 1.1  1997/08/29 08:54:33  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Advection term for scalar quantities using the Upstream scheme.
+!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
+!>       The same problem occurs for all topography boundaries!
+!------------------------------------------------------------------------------!
+ MODULE advec_s_up_mod
+ 
+
+    PRIVATE
+    PUBLIC advec_s_up
+
+    INTERFACE advec_s_up
+       MODULE PROCEDURE advec_s_up
+       MODULE PROCEDURE advec_s_up_ij
+    END INTERFACE advec_s_up
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_s_up( sk )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
+                  nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+       REAL(wp) ::  ukomp !<
+       REAL(wp) ::  vkomp !<
+       REAL(wp) ::  wkomp !<
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
+#endif
+
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_s_inner(j,i)+1, nzt
+!
+!--             x-direction
+                ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
+                IF ( ukomp > 0.0_wp )  THEN
+                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
+                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
+                ELSE
+                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
+                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
+                ENDIF
+!
+!--             y-direction
+                vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
+                IF ( vkomp > 0.0_wp )  THEN
+                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
+                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
+                ELSE
+                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
+                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
+                ENDIF
+!
+!--             z-direction
+                wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
+                IF ( wkomp > 0.0_wp )  THEN
+                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
+                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
+                ELSE
+                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
+                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
+                ENDIF
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE advec_s_up
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_s_up_ij( i, j, sk )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+       REAL(wp) ::  ukomp !<
+       REAL(wp) ::  vkomp !<
+       REAL(wp) ::  wkomp !<
+       
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
+#endif
+
+
+       DO  k = nzb_s_inner(j,i)+1, nzt
+!
+!--       x-direction
+          ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
+          IF ( ukomp > 0.0_wp )  THEN
+             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
+                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
+          ELSE
+             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
+                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
+          ENDIF
+!
+!--       y-direction
+          vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
+          IF ( vkomp > 0.0_wp )  THEN
+             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
+                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
+          ELSE
+             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
+                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
+          ENDIF
+!
+!--       z-direction
+          wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
+          IF ( wkomp > 0.0_wp )  THEN
+             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
+                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
+          ELSE
+             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
+                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
+          ENDIF
+
+       ENDDO
+
+    END SUBROUTINE advec_s_up_ij
+
+ END MODULE advec_s_up_mod
Index: lm/trunk/SOURCE/advec_s_up_mod.f90
===================================================================
--- /palm/trunk/SOURCE/advec_s_up_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,236 +1,0 @@
-!> @file advec_s_up_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1374 2014-04-25 12:55:07Z raasch
-! missing variables added to ONLY list
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1010 2012-09-20 07:59:54Z raasch
-! cpp switch __nopointer added for pointer free version
-!
-! 981 2012-08-09 14:57:44Z maronga
-! Typo removed
-!
-! Revision 1.1  1997/08/29 08:54:33  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Advection term for scalar quantities using the Upstream scheme.
-!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
-!>       The same problem occurs for all topography boundaries!
-!------------------------------------------------------------------------------!
- MODULE advec_s_up_mod
- 
-
-    PRIVATE
-    PUBLIC advec_s_up
-
-    INTERFACE advec_s_up
-       MODULE PROCEDURE advec_s_up
-       MODULE PROCEDURE advec_s_up_ij
-    END INTERFACE advec_s_up
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_s_up( sk )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
-                  nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
-       REAL(wp) ::  ukomp !<
-       REAL(wp) ::  vkomp !<
-       REAL(wp) ::  wkomp !<
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
-#endif
-
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_s_inner(j,i)+1, nzt
-!
-!--             x-direction
-                ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
-                IF ( ukomp > 0.0_wp )  THEN
-                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
-                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
-                ELSE
-                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
-                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
-                ENDIF
-!
-!--             y-direction
-                vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
-                IF ( vkomp > 0.0_wp )  THEN
-                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
-                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
-                ELSE
-                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
-                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
-                ENDIF
-!
-!--             z-direction
-                wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
-                IF ( wkomp > 0.0_wp )  THEN
-                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
-                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
-                ELSE
-                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
-                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE advec_s_up
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_s_up_ij( i, j, sk )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
-       REAL(wp) ::  ukomp !<
-       REAL(wp) ::  vkomp !<
-       REAL(wp) ::  wkomp !<
-       
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk
-#endif
-
-
-       DO  k = nzb_s_inner(j,i)+1, nzt
-!
-!--       x-direction
-          ukomp = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
-          IF ( ukomp > 0.0_wp )  THEN
-             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
-                                         ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
-          ELSE
-             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
-                                         ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
-          ENDIF
-!
-!--       y-direction
-          vkomp = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
-          IF ( vkomp > 0.0_wp )  THEN
-             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
-                                         ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
-          ELSE
-             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
-                                         ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
-          ENDIF
-!
-!--       z-direction
-          wkomp = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
-          IF ( wkomp > 0.0_wp )  THEN
-             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
-                                         ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
-          ELSE
-             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
-                                         ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE advec_s_up_ij
-
- END MODULE advec_s_up_mod
Index: /palm/trunk/SOURCE/advec_u_pw.f90
===================================================================
--- /palm/trunk/SOURCE/advec_u_pw.f90	(revision 1873)
+++ /palm/trunk/SOURCE/advec_u_pw.f90	(revision 1873)
@@ -0,0 +1,173 @@
+!> @file advec_u_pw.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! Revision 1.1  1997/08/11 06:09:21  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Advection term for u velocity-component using Piacsek and Williams.
+!> Vertical advection at the first grid point above the surface is done with
+!> normal centred differences, because otherwise no information from the surface
+!> would be communicated upwards due to w=0 at K=nzb.
+!------------------------------------------------------------------------------!
+ MODULE advec_u_pw_mod
+ 
+
+    PRIVATE
+    PUBLIC advec_u_pw
+
+    INTERFACE advec_u_pw
+       MODULE PROCEDURE advec_u_pw
+       MODULE PROCEDURE advec_u_pw_ij
+    END INTERFACE advec_u_pw
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_u_pw
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxlu, nxr, nyn, nys, nzb_u_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+       
+       REAL(wp)    ::  gu !<
+       REAL(wp)    ::  gv !<
+ 
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+       DO  i = nxlu, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_u_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                        &
+                         ( u(k,j,i+1) * ( u(k,j,i+1) + u(k,j,i) - gu )         &
+                         - u(k,j,i-1) * ( u(k,j,i) + u(k,j,i-1) - gu ) ) * ddx &
+                       + ( u(k,j+1,i) * ( v(k,j+1,i) + v(k,j+1,i-1) - gv )     &
+                         - u(k,j-1,i) * ( v(k,j,i) + v(k,j,i-1) - gv ) ) * ddy &
+                       + ( u(k+1,j,i) * ( w(k,j,i) + w(k,j,i-1) )              &
+                         - u(k-1,j,i) * ( w(k-1,j,i) + w(k-1,j,i-1) ) )        &
+                                                                  * ddzw(k)    &
+                                                      )
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE advec_u_pw
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_u_pw_ij( i, j )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nzb_u_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+       
+       REAL(wp)    ::  gu !<
+       REAL(wp)    ::  gv !<
+
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+       DO  k = nzb_u_inner(j,i)+1, nzt
+          tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                              &
+                         ( u(k,j,i+1) * ( u(k,j,i+1) + u(k,j,i) - gu )         &
+                         - u(k,j,i-1) * ( u(k,j,i) + u(k,j,i-1) - gu ) ) * ddx &
+                       + ( u(k,j+1,i) * ( v(k,j+1,i) + v(k,j+1,i-1) - gv )     &
+                         - u(k,j-1,i) * ( v(k,j,i) + v(k,j,i-1) - gv ) ) * ddy &
+                       + ( u(k+1,j,i) * ( w(k,j,i) + w(k,j,i-1) )              &
+                         - u(k-1,j,i) * ( w(k-1,j,i) + w(k-1,j,i-1) ) )        &
+                                                                  * ddzw(k)    &
+                                                )
+       ENDDO
+
+    END SUBROUTINE advec_u_pw_ij
+
+ END MODULE advec_u_pw_mod
Index: lm/trunk/SOURCE/advec_u_pw_mod.f90
===================================================================
--- /palm/trunk/SOURCE/advec_u_pw_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,172 +1,0 @@
-!> @file advec_u_pw_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! Revision 1.1  1997/08/11 06:09:21  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Advection term for u velocity-component using Piacsek and Williams.
-!> Vertical advection at the first grid point above the surface is done with
-!> normal centred differences, because otherwise no information from the surface
-!> would be communicated upwards due to w=0 at K=nzb.
-!------------------------------------------------------------------------------!
- MODULE advec_u_pw_mod
- 
-
-    PRIVATE
-    PUBLIC advec_u_pw
-
-    INTERFACE advec_u_pw
-       MODULE PROCEDURE advec_u_pw
-       MODULE PROCEDURE advec_u_pw_ij
-    END INTERFACE advec_u_pw
- 
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_u_pw
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxlu, nxr, nyn, nys, nzb_u_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-       
-       REAL(wp)    ::  gu !<
-       REAL(wp)    ::  gv !<
- 
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-       DO  i = nxlu, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_u_inner(j,i)+1, nzt
-                tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                        &
-                         ( u(k,j,i+1) * ( u(k,j,i+1) + u(k,j,i) - gu )         &
-                         - u(k,j,i-1) * ( u(k,j,i) + u(k,j,i-1) - gu ) ) * ddx &
-                       + ( u(k,j+1,i) * ( v(k,j+1,i) + v(k,j+1,i-1) - gv )     &
-                         - u(k,j-1,i) * ( v(k,j,i) + v(k,j,i-1) - gv ) ) * ddy &
-                       + ( u(k+1,j,i) * ( w(k,j,i) + w(k,j,i-1) )              &
-                         - u(k-1,j,i) * ( w(k-1,j,i) + w(k-1,j,i-1) ) )        &
-                                                                  * ddzw(k)    &
-                                                      )
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE advec_u_pw
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_u_pw_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nzb_u_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-       
-       REAL(wp)    ::  gu !<
-       REAL(wp)    ::  gv !<
-
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-       DO  k = nzb_u_inner(j,i)+1, nzt
-          tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                              &
-                         ( u(k,j,i+1) * ( u(k,j,i+1) + u(k,j,i) - gu )         &
-                         - u(k,j,i-1) * ( u(k,j,i) + u(k,j,i-1) - gu ) ) * ddx &
-                       + ( u(k,j+1,i) * ( v(k,j+1,i) + v(k,j+1,i-1) - gv )     &
-                         - u(k,j-1,i) * ( v(k,j,i) + v(k,j,i-1) - gv ) ) * ddy &
-                       + ( u(k+1,j,i) * ( w(k,j,i) + w(k,j,i-1) )              &
-                         - u(k-1,j,i) * ( w(k-1,j,i) + w(k-1,j,i-1) ) )        &
-                                                                  * ddzw(k)    &
-                                                )
-       ENDDO
-
-    END SUBROUTINE advec_u_pw_ij
-
- END MODULE advec_u_pw_mod
Index: /palm/trunk/SOURCE/advec_u_up.f90
===================================================================
--- /palm/trunk/SOURCE/advec_u_up.f90	(revision 1873)
+++ /palm/trunk/SOURCE/advec_u_up.f90	(revision 1873)
@@ -0,0 +1,219 @@
+!> @file advec_u_up.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! Revision 1.1  1997/08/29 08:55:25  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Advection term for the u velocity-component using upstream scheme.
+!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
+!>       The same problem occurs for all topography boundaries!
+!------------------------------------------------------------------------------!
+ MODULE advec_u_up_mod
+ 
+
+    PRIVATE
+    PUBLIC advec_u_up
+
+    INTERFACE advec_u_up
+       MODULE PROCEDURE advec_u_up
+       MODULE PROCEDURE advec_u_up_ij
+    END INTERFACE advec_u_up
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_u_up
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxlu, nxr, nyn, nys, nzb_u_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+       REAL(wp) ::  ukomp !<
+       REAL(wp) ::  vkomp !<
+       REAL(wp) ::  wkomp !<
+
+       
+       DO  i = nxlu, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_u_inner(j,i)+1, nzt
+!
+!--             x-direction
+                ukomp = u(k,j,i) - u_gtrans
+                IF ( ukomp > 0.0_wp )  THEN
+                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
+                                         ( u(k,j,i) - u(k,j,i-1) ) * ddx
+                ELSE
+                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
+                                          ( u(k,j,i+1) - u(k,j,i) ) * ddx
+                ENDIF
+!
+!--             y-direction
+                vkomp = 0.25_wp * ( v(k,j,i)   + v(k,j+1,i) +                  &
+                                 v(k,j,i-1) + v(k,j+1,i-1) ) - v_gtrans
+                IF ( vkomp > 0.0_wp )  THEN
+                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
+                                         ( u(k,j,i) - u(k,j-1,i) ) * ddy
+                ELSE
+                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
+                                         ( u(k,j+1,i) - u(k,j,i) ) * ddy
+                ENDIF
+!
+!--             z-direction
+                wkomp = 0.25_wp * ( w(k,j,i)   + w(k-1,j,i) +                  &
+                                 w(k,j,i-1) + w(k-1,j,i-1) )
+                IF ( wkomp > 0.0_wp )  THEN
+                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
+                                         ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
+                ELSE
+                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
+                                         ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
+                ENDIF
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE advec_u_up
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_u_up_ij( i, j )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nzb_u_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+       REAL(wp) ::  ukomp !<
+       REAL(wp) ::  vkomp !<
+       REAL(wp) ::  wkomp !<
+
+
+       DO  k = nzb_u_inner(j,i)+1, nzt
+!
+!--       x-direction
+          ukomp = u(k,j,i) - u_gtrans
+          IF ( ukomp > 0.0_wp )  THEN
+             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
+                                         ( u(k,j,i) - u(k,j,i-1) ) * ddx
+          ELSE
+             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
+                                         ( u(k,j,i+1) - u(k,j,i) ) * ddx
+          ENDIF
+!
+!--       y-direction
+          vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + v(k,j,i-1) + v(k,j+1,i-1) &
+                         ) - v_gtrans
+          IF ( vkomp > 0.0_wp )  THEN
+             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
+                                         ( u(k,j,i) - u(k,j-1,i) ) * ddy
+          ELSE
+             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
+                                         ( u(k,j+1,i) - u(k,j,i) ) * ddy
+          ENDIF
+!
+!--       z-direction
+          wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) )
+          IF ( wkomp > 0.0_wp )  THEN
+             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
+                                         ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
+          ELSE
+             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
+                                         ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
+          ENDIF
+
+       ENDDO
+
+    END SUBROUTINE advec_u_up_ij
+
+ END MODULE advec_u_up_mod
Index: lm/trunk/SOURCE/advec_u_up_mod.f90
===================================================================
--- /palm/trunk/SOURCE/advec_u_up_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,218 +1,0 @@
-!> @file advec_u_up_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! Revision 1.1  1997/08/29 08:55:25  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Advection term for the u velocity-component using upstream scheme.
-!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
-!>       The same problem occurs for all topography boundaries!
-!------------------------------------------------------------------------------!
- MODULE advec_u_up_mod
- 
-
-    PRIVATE
-    PUBLIC advec_u_up
-
-    INTERFACE advec_u_up
-       MODULE PROCEDURE advec_u_up
-       MODULE PROCEDURE advec_u_up_ij
-    END INTERFACE advec_u_up
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_u_up
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxlu, nxr, nyn, nys, nzb_u_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
-       REAL(wp) ::  ukomp !<
-       REAL(wp) ::  vkomp !<
-       REAL(wp) ::  wkomp !<
-
-       
-       DO  i = nxlu, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_u_inner(j,i)+1, nzt
-!
-!--             x-direction
-                ukomp = u(k,j,i) - u_gtrans
-                IF ( ukomp > 0.0_wp )  THEN
-                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
-                                         ( u(k,j,i) - u(k,j,i-1) ) * ddx
-                ELSE
-                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
-                                          ( u(k,j,i+1) - u(k,j,i) ) * ddx
-                ENDIF
-!
-!--             y-direction
-                vkomp = 0.25_wp * ( v(k,j,i)   + v(k,j+1,i) +                  &
-                                 v(k,j,i-1) + v(k,j+1,i-1) ) - v_gtrans
-                IF ( vkomp > 0.0_wp )  THEN
-                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
-                                         ( u(k,j,i) - u(k,j-1,i) ) * ddy
-                ELSE
-                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
-                                         ( u(k,j+1,i) - u(k,j,i) ) * ddy
-                ENDIF
-!
-!--             z-direction
-                wkomp = 0.25_wp * ( w(k,j,i)   + w(k-1,j,i) +                  &
-                                 w(k,j,i-1) + w(k-1,j,i-1) )
-                IF ( wkomp > 0.0_wp )  THEN
-                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
-                                         ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
-                ELSE
-                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
-                                         ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE advec_u_up
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_u_up_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nzb_u_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
-       REAL(wp) ::  ukomp !<
-       REAL(wp) ::  vkomp !<
-       REAL(wp) ::  wkomp !<
-
-
-       DO  k = nzb_u_inner(j,i)+1, nzt
-!
-!--       x-direction
-          ukomp = u(k,j,i) - u_gtrans
-          IF ( ukomp > 0.0_wp )  THEN
-             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
-                                         ( u(k,j,i) - u(k,j,i-1) ) * ddx
-          ELSE
-             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
-                                         ( u(k,j,i+1) - u(k,j,i) ) * ddx
-          ENDIF
-!
-!--       y-direction
-          vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + v(k,j,i-1) + v(k,j+1,i-1) &
-                         ) - v_gtrans
-          IF ( vkomp > 0.0_wp )  THEN
-             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
-                                         ( u(k,j,i) - u(k,j-1,i) ) * ddy
-          ELSE
-             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
-                                         ( u(k,j+1,i) - u(k,j,i) ) * ddy
-          ENDIF
-!
-!--       z-direction
-          wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) )
-          IF ( wkomp > 0.0_wp )  THEN
-             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
-                                         ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
-          ELSE
-             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
-                                         ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE advec_u_up_ij
-
- END MODULE advec_u_up_mod
Index: /palm/trunk/SOURCE/advec_v_pw.f90
===================================================================
--- /palm/trunk/SOURCE/advec_v_pw.f90	(revision 1873)
+++ /palm/trunk/SOURCE/advec_v_pw.f90	(revision 1873)
@@ -0,0 +1,176 @@
+!> @file advec_v_pw.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! Revision 1.1  1997/08/11 06:09:57  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Advection term for v velocity-component using Piacsek and Williams.
+!> Vertical advection at the first grid point above the surface is done with
+!> normal centred differences, because otherwise no information from the surface
+!> would be communicated upwards due to w=0 at K=nzb.
+!------------------------------------------------------------------------------!
+ MODULE advec_v_pw_mod
+ 
+
+    PRIVATE
+    PUBLIC advec_v_pw
+
+    INTERFACE advec_v_pw
+       MODULE PROCEDURE advec_v_pw
+       MODULE PROCEDURE advec_v_pw_ij
+    END INTERFACE advec_v_pw
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_v_pw
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nysv, nzb_v_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+       
+       REAL(wp)    ::  gu !<
+       REAL(wp)    ::  gv !<
+ 
+
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+       DO  i = nxl, nxr
+          DO  j = nysv, nyn
+             DO  k = nzb_v_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                        &
+                         ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu )     &
+                         - v(k,j,i-1) * ( u(k,j-1,i) + u(k,j,i) - gu ) ) * ddx &
+                       + ( v(k,j+1,i) * ( v(k,j+1,i) + v(k,j,i) - gv )         &
+                         - v(k,j-1,i) * ( v(k,j,i) + v(k,j-1,i) - gv ) ) * ddy &
+                       + ( v(k+1,j,i) * ( w(k,j-1,i) + w(k,j,i) )              &
+                         - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) )        &
+                                                                  * ddzw(k)    &
+                                                      )
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE advec_v_pw
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_v_pw_ij( i, j )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nzb_v_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+       
+       REAL(wp)    ::  gu !<
+       REAL(wp)    ::  gv !<
+
+
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+       DO  k = nzb_v_inner(j,i)+1, nzt
+          tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                              &
+                         ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu )     &
+                         - v(k,j,i-1) * ( u(k,j-1,i) + u(k,j,i) - gu ) ) * ddx &
+                       + ( v(k,j+1,i) * ( v(k,j+1,i) + v(k,j,i) - gv )         &
+                         - v(k,j-1,i) * ( v(k,j,i) + v(k,j-1,i) - gv ) ) * ddy &
+                       + ( v(k+1,j,i) * ( w(k,j-1,i) + w(k,j,i) )              &
+                         - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) )        &
+                                                                  * ddzw(k)    &
+                                                )
+       ENDDO
+ 
+    END SUBROUTINE advec_v_pw_ij
+
+ END MODULE advec_v_pw_mod
+ 
Index: lm/trunk/SOURCE/advec_v_pw_mod.f90
===================================================================
--- /palm/trunk/SOURCE/advec_v_pw_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,175 +1,0 @@
-!> @file advec_v_pw_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! Revision 1.1  1997/08/11 06:09:57  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Advection term for v velocity-component using Piacsek and Williams.
-!> Vertical advection at the first grid point above the surface is done with
-!> normal centred differences, because otherwise no information from the surface
-!> would be communicated upwards due to w=0 at K=nzb.
-!------------------------------------------------------------------------------!
- MODULE advec_v_pw_mod
- 
-
-    PRIVATE
-    PUBLIC advec_v_pw
-
-    INTERFACE advec_v_pw
-       MODULE PROCEDURE advec_v_pw
-       MODULE PROCEDURE advec_v_pw_ij
-    END INTERFACE advec_v_pw
- 
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_v_pw
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nyn, nysv, nzb_v_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-       
-       REAL(wp)    ::  gu !<
-       REAL(wp)    ::  gv !<
- 
-
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-       DO  i = nxl, nxr
-          DO  j = nysv, nyn
-             DO  k = nzb_v_inner(j,i)+1, nzt
-                tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                        &
-                         ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu )     &
-                         - v(k,j,i-1) * ( u(k,j-1,i) + u(k,j,i) - gu ) ) * ddx &
-                       + ( v(k,j+1,i) * ( v(k,j+1,i) + v(k,j,i) - gv )         &
-                         - v(k,j-1,i) * ( v(k,j,i) + v(k,j-1,i) - gv ) ) * ddy &
-                       + ( v(k+1,j,i) * ( w(k,j-1,i) + w(k,j,i) )              &
-                         - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) )        &
-                                                                  * ddzw(k)    &
-                                                      )
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE advec_v_pw
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_v_pw_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nzb_v_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-       
-       REAL(wp)    ::  gu !<
-       REAL(wp)    ::  gv !<
-
-
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-       DO  k = nzb_v_inner(j,i)+1, nzt
-          tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                              &
-                         ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu )     &
-                         - v(k,j,i-1) * ( u(k,j-1,i) + u(k,j,i) - gu ) ) * ddx &
-                       + ( v(k,j+1,i) * ( v(k,j+1,i) + v(k,j,i) - gv )         &
-                         - v(k,j-1,i) * ( v(k,j,i) + v(k,j-1,i) - gv ) ) * ddy &
-                       + ( v(k+1,j,i) * ( w(k,j-1,i) + w(k,j,i) )              &
-                         - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) )        &
-                                                                  * ddzw(k)    &
-                                                )
-       ENDDO
- 
-    END SUBROUTINE advec_v_pw_ij
-
- END MODULE advec_v_pw_mod
- 
Index: /palm/trunk/SOURCE/advec_v_up.f90
===================================================================
--- /palm/trunk/SOURCE/advec_v_up.f90	(revision 1873)
+++ /palm/trunk/SOURCE/advec_v_up.f90	(revision 1873)
@@ -0,0 +1,219 @@
+!> @file advec_v_up.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! Revision 1.1  1997/08/29 08:56:05  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Advection term for the v velocity-component using upstream scheme.
+!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
+!>       The same problem occurs for all topography boundaries!
+!------------------------------------------------------------------------------!
+ MODULE advec_v_up_mod
+ 
+
+    PRIVATE
+    PUBLIC advec_v_up
+
+    INTERFACE advec_v_up
+       MODULE PROCEDURE advec_v_up
+       MODULE PROCEDURE advec_v_up_ij
+    END INTERFACE advec_v_up
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_v_up
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nysv, nzb_v_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+       REAL(wp) ::  ukomp !<
+       REAL(wp) ::  vkomp !<
+       REAL(wp) ::  wkomp !<       
+
+
+       DO  i = nxl, nxr
+          DO  j = nysv, nyn
+             DO  k = nzb_v_inner(j,i)+1, nzt
+!
+!--             x-direction
+                ukomp = 0.25_wp * ( u(k,j,i)   + u(k,j-1,i) +                  &
+                                 u(k,j,i+1) + u(k,j-1,i+1) ) - u_gtrans
+                IF ( ukomp > 0.0_wp )  THEN
+                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
+                                         ( v(k,j,i) - v(k,j,i-1) ) * ddx
+                ELSE
+                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
+                                         ( v(k,j,i+1) - v(k,j,i) ) * ddx
+                ENDIF
+!
+!--             y-direction
+                vkomp = v(k,j,i) - v_gtrans
+                IF ( vkomp > 0.0_wp )  THEN
+                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
+                                         ( v(k,j,i) - v(k,j-1,i) ) * ddy
+                ELSE
+                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
+                                         ( v(k,j+1,i) - v(k,j,i) ) * ddy
+                ENDIF
+!
+!--             z-direction
+                wkomp = 0.25_wp * ( w(k,j,i)  + w(k-1,j,i) +                   &
+                                 w(k,j-1,i) + w(k-1,j-1,i) )
+                IF ( wkomp > 0.0_wp )  THEN
+                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
+                                         ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)
+                ELSE
+                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
+                                         ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)
+                ENDIF
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE advec_v_up
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_v_up_ij( i, j )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nzb_v_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+       REAL(wp) ::  ukomp !<
+       REAL(wp) ::  vkomp !<
+       REAL(wp) ::  wkomp !<
+
+
+       DO  k = nzb_v_inner(j,i)+1, nzt
+!
+!--       x-direction
+          ukomp = 0.25_wp * ( u(k,j,i) + u(k,j-1,i) + u(k,j,i+1) + u(k,j-1,i+1) &
+                         ) - u_gtrans
+          IF ( ukomp > 0.0_wp )  THEN
+             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
+                                         ( v(k,j,i) - v(k,j,i-1) ) * ddx
+          ELSE
+             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
+                                         ( v(k,j,i+1) - v(k,j,i) ) * ddx
+          ENDIF
+!
+!--       y-direction
+          vkomp = v(k,j,i) - v_gtrans
+          IF ( vkomp > 0.0_wp )  THEN
+             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
+                                         ( v(k,j,i) - v(k,j-1,i) ) * ddy
+          ELSE
+             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
+                                         ( v(k,j+1,i) - v(k,j,i) ) * ddy
+          ENDIF
+!
+!--       z-direction
+          wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) )
+          IF ( wkomp > 0.0_wp )  THEN
+             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
+                                         ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)
+          ELSE
+             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
+                                         ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)
+          ENDIF
+
+       ENDDO
+
+    END SUBROUTINE advec_v_up_ij
+
+ END MODULE advec_v_up_mod
Index: lm/trunk/SOURCE/advec_v_up_mod.f90
===================================================================
--- /palm/trunk/SOURCE/advec_v_up_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,218 +1,0 @@
-!> @file advec_v_up_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! Revision 1.1  1997/08/29 08:56:05  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Advection term for the v velocity-component using upstream scheme.
-!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
-!>       The same problem occurs for all topography boundaries!
-!------------------------------------------------------------------------------!
- MODULE advec_v_up_mod
- 
-
-    PRIVATE
-    PUBLIC advec_v_up
-
-    INTERFACE advec_v_up
-       MODULE PROCEDURE advec_v_up
-       MODULE PROCEDURE advec_v_up_ij
-    END INTERFACE advec_v_up
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_v_up
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nyn, nysv, nzb_v_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
-       REAL(wp) ::  ukomp !<
-       REAL(wp) ::  vkomp !<
-       REAL(wp) ::  wkomp !<       
-
-
-       DO  i = nxl, nxr
-          DO  j = nysv, nyn
-             DO  k = nzb_v_inner(j,i)+1, nzt
-!
-!--             x-direction
-                ukomp = 0.25_wp * ( u(k,j,i)   + u(k,j-1,i) +                  &
-                                 u(k,j,i+1) + u(k,j-1,i+1) ) - u_gtrans
-                IF ( ukomp > 0.0_wp )  THEN
-                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
-                                         ( v(k,j,i) - v(k,j,i-1) ) * ddx
-                ELSE
-                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
-                                         ( v(k,j,i+1) - v(k,j,i) ) * ddx
-                ENDIF
-!
-!--             y-direction
-                vkomp = v(k,j,i) - v_gtrans
-                IF ( vkomp > 0.0_wp )  THEN
-                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
-                                         ( v(k,j,i) - v(k,j-1,i) ) * ddy
-                ELSE
-                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
-                                         ( v(k,j+1,i) - v(k,j,i) ) * ddy
-                ENDIF
-!
-!--             z-direction
-                wkomp = 0.25_wp * ( w(k,j,i)  + w(k-1,j,i) +                   &
-                                 w(k,j-1,i) + w(k-1,j-1,i) )
-                IF ( wkomp > 0.0_wp )  THEN
-                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
-                                         ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)
-                ELSE
-                   tend(k,j,i) = tend(k,j,i) - wkomp *                         &
-                                         ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE advec_v_up
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_v_up_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nzb_v_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
-       REAL(wp) ::  ukomp !<
-       REAL(wp) ::  vkomp !<
-       REAL(wp) ::  wkomp !<
-
-
-       DO  k = nzb_v_inner(j,i)+1, nzt
-!
-!--       x-direction
-          ukomp = 0.25_wp * ( u(k,j,i) + u(k,j-1,i) + u(k,j,i+1) + u(k,j-1,i+1) &
-                         ) - u_gtrans
-          IF ( ukomp > 0.0_wp )  THEN
-             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
-                                         ( v(k,j,i) - v(k,j,i-1) ) * ddx
-          ELSE
-             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
-                                         ( v(k,j,i+1) - v(k,j,i) ) * ddx
-          ENDIF
-!
-!--       y-direction
-          vkomp = v(k,j,i) - v_gtrans
-          IF ( vkomp > 0.0_wp )  THEN
-             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
-                                         ( v(k,j,i) - v(k,j-1,i) ) * ddy
-          ELSE
-             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
-                                         ( v(k,j+1,i) - v(k,j,i) ) * ddy
-          ENDIF
-!
-!--       z-direction
-          wkomp = 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) )
-          IF ( wkomp > 0.0_wp )  THEN
-             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
-                                         ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)
-          ELSE
-             tend(k,j,i) = tend(k,j,i) - wkomp *                               &
-                                         ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE advec_v_up_ij
-
- END MODULE advec_v_up_mod
Index: /palm/trunk/SOURCE/advec_w_pw.f90
===================================================================
--- /palm/trunk/SOURCE/advec_w_pw.f90	(revision 1873)
+++ /palm/trunk/SOURCE/advec_w_pw.f90	(revision 1873)
@@ -0,0 +1,173 @@
+!> @file advec_w_pw.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! Revision 1.1  1997/08/11 06:10:29  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Advection term for w velocity-component using Piacsek and Williams.
+!> Vertical advection at the first grid point above the surface is done with
+!> normal centred differences, because otherwise no information from the surface
+!> would be communicated upwards due to w=0 at k=nzb.
+!------------------------------------------------------------------------------!
+ MODULE advec_w_pw_mod
+ 
+
+    PRIVATE
+    PUBLIC advec_w_pw
+
+    INTERFACE advec_w_pw
+       MODULE PROCEDURE advec_w_pw
+       MODULE PROCEDURE advec_w_pw_ij
+    END INTERFACE advec_w_pw
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_w_pw
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nys, nzb_w_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+       
+       REAL(wp)    ::  gu !<
+       REAL(wp)    ::  gv !<
+
+ 
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_w_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                        &
+                         ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu )     &
+                         - w(k,j,i-1) * ( u(k+1,j,i) + u(k,j,i) - gu ) ) * ddx &
+                       + ( w(k,j+1,i) * ( v(k+1,j+1,i) + v(k,j+1,i) - gv )     &
+                         - w(k,j-1,i) * ( v(k+1,j,i) + v(k,j,i) - gv ) ) * ddy &
+                       + ( w(k+1,j,i) * ( w(k+1,j,i) + w(k,j,i) )              &
+                         - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) )            &
+                                                                  * ddzu(k+1)  &
+                                                      )
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE advec_w_pw
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_w_pw_ij( i, j )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nzb_w_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+       
+       REAL(wp)    ::  gu !<
+       REAL(wp)    ::  gv !<
+
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+       DO  k = nzb_w_inner(j,i)+1, nzt
+          tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                              &
+                         ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu )     &
+                         - w(k,j,i-1) * ( u(k+1,j,i) + u(k,j,i) - gu ) ) * ddx &
+                       + ( w(k,j+1,i) * ( v(k+1,j+1,i) + v(k,j+1,i) - gv )     &
+                         - w(k,j-1,i) * ( v(k+1,j,i) + v(k,j,i) - gv ) ) * ddy &
+                       + ( w(k+1,j,i) * ( w(k+1,j,i) + w(k,j,i) )              &
+                         - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) )            &
+                                                                  * ddzu(k+1)  &
+                                                )
+       ENDDO
+    END SUBROUTINE advec_w_pw_ij
+
+ END MODULE advec_w_pw_mod
Index: lm/trunk/SOURCE/advec_w_pw_mod.f90
===================================================================
--- /palm/trunk/SOURCE/advec_w_pw_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,172 +1,0 @@
-!> @file advec_w_pw_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! Revision 1.1  1997/08/11 06:10:29  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Advection term for w velocity-component using Piacsek and Williams.
-!> Vertical advection at the first grid point above the surface is done with
-!> normal centred differences, because otherwise no information from the surface
-!> would be communicated upwards due to w=0 at k=nzb.
-!------------------------------------------------------------------------------!
- MODULE advec_w_pw_mod
- 
-
-    PRIVATE
-    PUBLIC advec_w_pw
-
-    INTERFACE advec_w_pw
-       MODULE PROCEDURE advec_w_pw
-       MODULE PROCEDURE advec_w_pw_ij
-    END INTERFACE advec_w_pw
- 
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_w_pw
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nyn, nys, nzb_w_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-       
-       REAL(wp)    ::  gu !<
-       REAL(wp)    ::  gv !<
-
- 
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_w_inner(j,i)+1, nzt
-                tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                        &
-                         ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu )     &
-                         - w(k,j,i-1) * ( u(k+1,j,i) + u(k,j,i) - gu ) ) * ddx &
-                       + ( w(k,j+1,i) * ( v(k+1,j+1,i) + v(k,j+1,i) - gv )     &
-                         - w(k,j-1,i) * ( v(k+1,j,i) + v(k,j,i) - gv ) ) * ddy &
-                       + ( w(k+1,j,i) * ( w(k+1,j,i) + w(k,j,i) )              &
-                         - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) )            &
-                                                                  * ddzu(k+1)  &
-                                                      )
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE advec_w_pw
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_w_pw_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nzb_w_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-       
-       REAL(wp)    ::  gu !<
-       REAL(wp)    ::  gv !<
-
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-       DO  k = nzb_w_inner(j,i)+1, nzt
-          tend(k,j,i) = tend(k,j,i) - 0.25_wp * (                              &
-                         ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu )     &
-                         - w(k,j,i-1) * ( u(k+1,j,i) + u(k,j,i) - gu ) ) * ddx &
-                       + ( w(k,j+1,i) * ( v(k+1,j+1,i) + v(k,j+1,i) - gv )     &
-                         - w(k,j-1,i) * ( v(k+1,j,i) + v(k,j,i) - gv ) ) * ddy &
-                       + ( w(k+1,j,i) * ( w(k+1,j,i) + w(k,j,i) )              &
-                         - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) )            &
-                                                                  * ddzu(k+1)  &
-                                                )
-       ENDDO
-    END SUBROUTINE advec_w_pw_ij
-
- END MODULE advec_w_pw_mod
Index: /palm/trunk/SOURCE/advec_w_up.f90
===================================================================
--- /palm/trunk/SOURCE/advec_w_up.f90	(revision 1873)
+++ /palm/trunk/SOURCE/advec_w_up.f90	(revision 1873)
@@ -0,0 +1,216 @@
+!> @file advec_w_up.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! Revision 1.1  1997/08/29 08:56:33  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Advection term for the w velocity-component using upstream scheme.
+!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0
+!>       The same problem occurs for all topography boundaries!
+!------------------------------------------------------------------------------!
+ MODULE advec_w_up_mod
+ 
+
+    PRIVATE
+    PUBLIC advec_w_up
+
+    INTERFACE advec_w_up
+       MODULE PROCEDURE advec_w_up
+       MODULE PROCEDURE advec_w_up_ij
+    END INTERFACE advec_w_up
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_w_up
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nys, nzb_w_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+       REAL(wp) ::  ukomp !<
+       REAL(wp) ::  vkomp !<
+
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_w_inner(j,i)+1, nzt-1
+!
+!--             x-direction
+                ukomp = 0.25_wp * ( u(k,j,i)   + u(k,j,i+1) +                  &
+                                 u(k+1,j,i) + u(k+1,j,i+1) ) - u_gtrans
+                IF ( ukomp > 0.0_wp )  THEN
+                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
+                                         ( w(k,j,i) - w(k,j,i-1) ) * ddx
+                ELSE
+                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
+                                         ( w(k,j,i+1) - w(k,j,i) ) * ddx
+                ENDIF
+!
+!--             y-direction
+                vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) +                    &
+                                 v(k+1,j,i) + v(k+1,j+1,i) ) - v_gtrans
+                IF ( vkomp > 0.0_wp )  THEN
+                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
+                                         ( w(k,j,i) - w(k,j-1,i) ) * ddy
+                ELSE
+                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
+                                         ( w(k,j+1,i) - w(k,j,i) ) * ddy
+                ENDIF
+!
+!--             z-direction
+                IF ( w(k,j,i) > 0.0_wp )  THEN
+                   tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                      &
+                                         ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+                ELSE
+                   tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                      &
+                                         ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
+                ENDIF
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE advec_w_up
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_w_up_ij( i, j )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nzb_w_inner, nzt
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+       REAL(wp) ::  ukomp !<
+       REAL(wp) ::  vkomp !<
+
+
+       DO  k = nzb_w_inner(j,i)+1, nzt-1
+!
+!--       x-direction
+          ukomp = 0.25_wp * ( u(k,j,i) + u(k,j,i+1) + u(k+1,j,i) + u(k+1,j,i+1) &
+                         ) - u_gtrans
+          IF ( ukomp > 0.0_wp )  THEN
+             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
+                                         ( w(k,j,i) - w(k,j,i-1) ) * ddx
+          ELSE
+             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
+                                         ( w(k,j,i+1) - w(k,j,i) ) * ddx
+          ENDIF
+!
+!--       y-direction
+          vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + v(k+1,j,i) + v(k+1,j+1,i) &
+                         ) - v_gtrans
+          IF ( vkomp > 0.0_wp )  THEN
+             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
+                                         ( w(k,j,i) - w(k,j-1,i) ) * ddy
+          ELSE
+             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
+                                         ( w(k,j+1,i) - w(k,j,i) ) * ddy
+          ENDIF
+!
+!--       z-direction
+          IF ( w(k,j,i) > 0.0_wp )  THEN
+             tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                            &
+                                         ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+          ELSE
+             tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                            &
+                                         ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
+          ENDIF
+
+       ENDDO
+
+    END SUBROUTINE advec_w_up_ij
+
+ END MODULE advec_w_up_mod
Index: lm/trunk/SOURCE/advec_w_up_mod.f90
===================================================================
--- /palm/trunk/SOURCE/advec_w_up_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,215 +1,0 @@
-!> @file advec_w_up_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! Revision 1.1  1997/08/29 08:56:33  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Advection term for the w velocity-component using upstream scheme.
-!> NOTE: vertical advection at k=1 still has wrong grid spacing for w>0
-!>       The same problem occurs for all topography boundaries!
-!------------------------------------------------------------------------------!
- MODULE advec_w_up_mod
- 
-
-    PRIVATE
-    PUBLIC advec_w_up
-
-    INTERFACE advec_w_up
-       MODULE PROCEDURE advec_w_up
-       MODULE PROCEDURE advec_w_up_ij
-    END INTERFACE advec_w_up
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_w_up
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nyn, nys, nzb_w_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
-       REAL(wp) ::  ukomp !<
-       REAL(wp) ::  vkomp !<
-
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_w_inner(j,i)+1, nzt-1
-!
-!--             x-direction
-                ukomp = 0.25_wp * ( u(k,j,i)   + u(k,j,i+1) +                  &
-                                 u(k+1,j,i) + u(k+1,j,i+1) ) - u_gtrans
-                IF ( ukomp > 0.0_wp )  THEN
-                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
-                                         ( w(k,j,i) - w(k,j,i-1) ) * ddx
-                ELSE
-                   tend(k,j,i) = tend(k,j,i) - ukomp *                         &
-                                         ( w(k,j,i+1) - w(k,j,i) ) * ddx
-                ENDIF
-!
-!--             y-direction
-                vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) +                    &
-                                 v(k+1,j,i) + v(k+1,j+1,i) ) - v_gtrans
-                IF ( vkomp > 0.0_wp )  THEN
-                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
-                                         ( w(k,j,i) - w(k,j-1,i) ) * ddy
-                ELSE
-                   tend(k,j,i) = tend(k,j,i) - vkomp *                         &
-                                         ( w(k,j+1,i) - w(k,j,i) ) * ddy
-                ENDIF
-!
-!--             z-direction
-                IF ( w(k,j,i) > 0.0_wp )  THEN
-                   tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                      &
-                                         ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
-                ELSE
-                   tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                      &
-                                         ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE advec_w_up
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_w_up_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE control_parameters,                                                 &
-           ONLY:  u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nzb_w_inner, nzt
-
-       USE kinds
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
-       REAL(wp) ::  ukomp !<
-       REAL(wp) ::  vkomp !<
-
-
-       DO  k = nzb_w_inner(j,i)+1, nzt-1
-!
-!--       x-direction
-          ukomp = 0.25_wp * ( u(k,j,i) + u(k,j,i+1) + u(k+1,j,i) + u(k+1,j,i+1) &
-                         ) - u_gtrans
-          IF ( ukomp > 0.0_wp )  THEN
-             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
-                                         ( w(k,j,i) - w(k,j,i-1) ) * ddx
-          ELSE
-             tend(k,j,i) = tend(k,j,i) - ukomp *                               &
-                                         ( w(k,j,i+1) - w(k,j,i) ) * ddx
-          ENDIF
-!
-!--       y-direction
-          vkomp = 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + v(k+1,j,i) + v(k+1,j+1,i) &
-                         ) - v_gtrans
-          IF ( vkomp > 0.0_wp )  THEN
-             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
-                                         ( w(k,j,i) - w(k,j-1,i) ) * ddy
-          ELSE
-             tend(k,j,i) = tend(k,j,i) - vkomp *                               &
-                                         ( w(k,j+1,i) - w(k,j,i) ) * ddy
-          ENDIF
-!
-!--       z-direction
-          IF ( w(k,j,i) > 0.0_wp )  THEN
-             tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                            &
-                                         ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
-          ELSE
-             tend(k,j,i) = tend(k,j,i) - w(k,j,i) *                            &
-                                         ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE advec_w_up_ij
-
- END MODULE advec_w_up_mod
Index: /palm/trunk/SOURCE/advec_ws.f90
===================================================================
--- /palm/trunk/SOURCE/advec_ws.f90	(revision 1873)
+++ /palm/trunk/SOURCE/advec_ws.f90	(revision 1873)
@@ -0,0 +1,6445 @@
+!> @file advec_ws.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$ 
+! 
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+!
+! 
+! 1822 2016-04-07 07:49:42Z hoffmann
+! icloud_scheme removed, microphysics_seifert added
+!
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1630 2015-08-26 16:57:23Z suehring
+! 
+! 
+! 1629 2015-08-26 16:56:11Z suehring
+! Bugfix concerning wall_flags at left and south PE boundaries
+!
+! 1581 2015-04-10 13:45:59Z suehring
+! 
+! 
+! 1580 2015-04-10 13:43:49Z suehring
+! Bugfix: statistical evaluation of scalar fluxes in case of monotonic limiter
+!
+! 1567 2015-03-10 17:57:55Z suehring
+! Bugfixes in monotonic limiter.
+!
+! 2015-03-09 13:10:37Z heinze
+! Bugfix: REAL constants provided with KIND-attribute in call of 
+! intrinsic functions like MAX and MIN 
+! 
+! 1557 2015-03-05 16:43:04Z suehring
+! Enable monotone advection for scalars using monotonic limiter
+!
+! 1374 2014-04-25 12:55:07Z raasch
+! missing variables added to ONLY list
+! 
+! 1361 2014-04-16 15:17:48Z hoffmann
+! accelerator and vector version for qr and nr added
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute,
+! module kinds added
+! some formatting adjustments
+!
+! 1322 2014-03-20 16:38:49Z raasch
+! REAL constants defined as wp-kind
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! old module precision_kind is removed,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1257 2013-11-08 15:18:40Z raasch
+! accelerator loop directives removed
+!
+! 1221 2013-09-10 08:59:13Z raasch
+! wall_flags_00 introduced, which holds bits 32-...
+!
+! 1128 2013-04-12 06:19:32Z raasch
+! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
+! j_north
+!
+! 1115 2013-03-26 18:16:16Z hoffmann
+! calculation of qr and nr is restricted to precipitation
+!
+! 1053 2012-11-13 17:11:03Z hoffmann
+! necessary expansions according to the two new prognostic equations (nr, qr) 
+! of the two-moment cloud physics scheme:
+! +flux_l_*, flux_s_*, diss_l_*, diss_s_*, sums_ws*s_ws_l 
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1027 2012-10-15 17:18:39Z suehring
+! Bugfix in calculation indices k_mm, k_pp in accelerator version
+!
+! 1019 2012-09-28 06:46:45Z raasch
+! small change in comment lines
+!
+! 1015 2012-09-27 09:23:24Z raasch
+! accelerator versions (*_acc) added
+!
+! 1010 2012-09-20 07:59:54Z raasch
+! cpp switch __nopointer added for pointer free version
+!
+! 888 2012-04-20 15:03:46Z suehring
+! Number of IBITS() calls with identical arguments is reduced.
+!
+! 862 2012-03-26 14:21:38Z suehring
+! ws-scheme also work with topography in combination with vector version.
+! ws-scheme also work with outflow boundaries in combination with
+! vector version.
+! Degradation of the applied order of scheme is now steered by multiplying with
+! Integer wall_flags_0. 2nd order scheme, WS3 and WS5 are calculated on each
+! grid point and mulitplied with the appropriate flag.
+! 2nd order numerical dissipation term changed. Now the appropriate 2nd order
+! term derived according to the 4th and 6th order terms is applied. It turns
+! out that diss_2nd does not provide sufficient dissipation near walls.
+! Therefore, the function diss_2nd is removed.
+! Near walls a divergence correction is necessary to overcome numerical
+! instabilities due to too less divergence reduction of the velocity field.
+! boundary_flags and logicals steering the degradation are removed.
+! Empty SUBROUTINE local_diss removed.
+! Further formatting adjustments.
+!
+! 801 2012-01-10 17:30:36Z suehring
+! Bugfix concerning OpenMP parallelization. Summation of sums_wsus_ws_l,
+! sums_wsvs_ws_l, sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wspts_ws_l,
+! sums_wsqs_ws_l, sums_wssas_ws_l is now thread-safe by adding an additional
+! dimension.
+!
+! Initial revision
+!
+! 411 2009-12-11 12:31:43 Z suehring
+!
+! Description:
+! ------------
+!> Advection scheme for scalars and momentum using the flux formulation of
+!> Wicker and Skamarock 5th order. Additionally the module contains of a 
+!> routine using for initialisation and steering of the statical evaluation. 
+!> The computation of turbulent fluxes takes place inside the advection
+!> routines.
+!> Near non-cyclic boundaries the order of the applied advection scheme is
+!> degraded.
+!> A divergence correction is applied. It is necessary for topography, since
+!> the divergence is not sufficiently reduced, resulting in erroneous fluxes and
+!> partly numerical instabilities. 
+!-----------------------------------------------------------------------------!
+ MODULE advec_ws
+
+ 
+
+    PRIVATE
+    PUBLIC   advec_s_ws, advec_s_ws_acc, advec_u_ws, advec_u_ws_acc,          &
+             advec_v_ws, advec_v_ws_acc, advec_w_ws, advec_w_ws_acc,          &
+             ws_init, ws_statistics
+
+    INTERFACE ws_init
+       MODULE PROCEDURE ws_init
+    END INTERFACE ws_init
+
+    INTERFACE ws_statistics
+       MODULE PROCEDURE ws_statistics
+    END INTERFACE ws_statistics
+
+    INTERFACE advec_s_ws
+       MODULE PROCEDURE advec_s_ws
+       MODULE PROCEDURE advec_s_ws_ij
+    END INTERFACE advec_s_ws
+
+    INTERFACE advec_u_ws
+       MODULE PROCEDURE advec_u_ws
+       MODULE PROCEDURE advec_u_ws_ij
+    END INTERFACE advec_u_ws
+
+    INTERFACE advec_u_ws_acc
+       MODULE PROCEDURE advec_u_ws_acc
+    END INTERFACE advec_u_ws_acc
+
+    INTERFACE advec_v_ws
+       MODULE PROCEDURE advec_v_ws
+       MODULE PROCEDURE advec_v_ws_ij
+    END INTERFACE advec_v_ws
+
+    INTERFACE advec_v_ws_acc
+       MODULE PROCEDURE advec_v_ws_acc
+    END INTERFACE advec_v_ws_acc
+
+    INTERFACE advec_w_ws
+       MODULE PROCEDURE advec_w_ws
+       MODULE PROCEDURE advec_w_ws_ij
+    END INTERFACE advec_w_ws
+
+    INTERFACE advec_w_ws_acc
+       MODULE PROCEDURE advec_w_ws_acc
+    END INTERFACE advec_w_ws_acc
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Initialization of WS-scheme
+!------------------------------------------------------------------------------!
+    SUBROUTINE ws_init
+
+       USE arrays_3d,                                                          &
+           ONLY:  diss_l_e, diss_l_nr, diss_l_pt, diss_l_q, diss_l_qr,         &
+                  diss_l_sa, diss_l_u, diss_l_v, diss_l_w,  flux_l_e,          &
+                  flux_l_nr, flux_l_pt, flux_l_q, flux_l_qr, flux_l_sa,        &
+                  flux_l_u, flux_l_v, flux_l_w, diss_s_e, diss_s_nr, diss_s_pt,&
+                  diss_s_q, diss_s_qr, diss_s_sa, diss_s_u, diss_s_v, diss_s_w,& 
+                  flux_s_e, flux_s_nr, flux_s_pt, flux_s_q, flux_s_qr,         &
+                  flux_s_sa, flux_s_u, flux_s_v, flux_s_w
+
+       USE constants,                                                          &
+           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5, adv_sca_1, adv_sca_3,       &
+                  adv_sca_5
+
+       USE control_parameters,                                                 &
+           ONLY:  cloud_physics, humidity, loop_optimization,                  &
+                  monotonic_adjustment, passive_scalar, microphysics_seifert,  &
+                  ocean, ws_scheme_mom, ws_scheme_sca
+
+       USE indices,                                                            &
+           ONLY:  nyn, nys, nzb, nzt
+
+       USE kinds
+       
+       USE pegrid
+
+       USE statistics,                                                         &
+           ONLY:  sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wsnrs_ws_l,&
+                  sums_wspts_ws_l, sums_wsqrs_ws_l, sums_wsqs_ws_l,            &
+                  sums_wssas_ws_l,  sums_wsus_ws_l, sums_wsvs_ws_l  
+
+!
+!--    Set the appropriate factors for scalar and momentum advection.
+       adv_sca_5 = 1.0_wp /  60.0_wp
+       adv_sca_3 = 1.0_wp /  12.0_wp
+       adv_sca_1 = 1.0_wp /   2.0_wp
+       adv_mom_5 = 1.0_wp / 120.0_wp
+       adv_mom_3 = 1.0_wp /  24.0_wp
+       adv_mom_1 = 1.0_wp /   4.0_wp
+!         
+!--    Arrays needed for statical evaluation of fluxes.
+       IF ( ws_scheme_mom )  THEN
+
+          ALLOCATE( sums_wsus_ws_l(nzb:nzt+1,0:threads_per_task-1),            &
+                    sums_wsvs_ws_l(nzb:nzt+1,0:threads_per_task-1),            &
+                    sums_us2_ws_l(nzb:nzt+1,0:threads_per_task-1),             &
+                    sums_vs2_ws_l(nzb:nzt+1,0:threads_per_task-1),             &
+                    sums_ws2_ws_l(nzb:nzt+1,0:threads_per_task-1) )
+
+          sums_wsus_ws_l = 0.0_wp
+          sums_wsvs_ws_l = 0.0_wp
+          sums_us2_ws_l  = 0.0_wp
+          sums_vs2_ws_l  = 0.0_wp
+          sums_ws2_ws_l  = 0.0_wp
+
+       ENDIF
+
+       IF ( ws_scheme_sca )  THEN
+
+          ALLOCATE( sums_wspts_ws_l(nzb:nzt+1,0:threads_per_task-1) )
+          sums_wspts_ws_l = 0.0_wp
+
+          IF ( humidity  .OR.  passive_scalar )  THEN
+             ALLOCATE( sums_wsqs_ws_l(nzb:nzt+1,0:threads_per_task-1) )
+             sums_wsqs_ws_l = 0.0_wp
+          ENDIF
+
+          IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
+             ALLOCATE( sums_wsqrs_ws_l(nzb:nzt+1,0:threads_per_task-1) )
+             ALLOCATE( sums_wsnrs_ws_l(nzb:nzt+1,0:threads_per_task-1) )
+             sums_wsqrs_ws_l = 0.0_wp
+             sums_wsnrs_ws_l = 0.0_wp
+          ENDIF
+
+          IF ( ocean )  THEN
+             ALLOCATE( sums_wssas_ws_l(nzb:nzt+1,0:threads_per_task-1) )
+             sums_wssas_ws_l = 0.0_wp
+          ENDIF
+
+       ENDIF
+
+!
+!--    Arrays needed for reasons of speed optimization for cache version.
+!--    For the vector version the buffer arrays are not necessary,
+!--    because the the fluxes can swapped directly inside the loops of the 
+!--    advection routines.
+       IF ( loop_optimization /= 'vector' )  THEN
+
+          IF ( ws_scheme_mom )  THEN
+
+             ALLOCATE( flux_s_u(nzb+1:nzt,0:threads_per_task-1),               &
+                       flux_s_v(nzb+1:nzt,0:threads_per_task-1),               &
+                       flux_s_w(nzb+1:nzt,0:threads_per_task-1),               &
+                       diss_s_u(nzb+1:nzt,0:threads_per_task-1),               &
+                       diss_s_v(nzb+1:nzt,0:threads_per_task-1),               &
+                       diss_s_w(nzb+1:nzt,0:threads_per_task-1) )
+             ALLOCATE( flux_l_u(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
+                       flux_l_v(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
+                       flux_l_w(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
+                       diss_l_u(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
+                       diss_l_v(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
+                       diss_l_w(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
+
+          ENDIF
+
+          IF ( ws_scheme_sca )  THEN
+
+             ALLOCATE( flux_s_pt(nzb+1:nzt,0:threads_per_task-1),              &
+                       flux_s_e(nzb+1:nzt,0:threads_per_task-1),               &
+                       diss_s_pt(nzb+1:nzt,0:threads_per_task-1),              &
+                       diss_s_e(nzb+1:nzt,0:threads_per_task-1) ) 
+             ALLOCATE( flux_l_pt(nzb+1:nzt,nys:nyn,0:threads_per_task-1),      &
+                       flux_l_e(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
+                       diss_l_pt(nzb+1:nzt,nys:nyn,0:threads_per_task-1),      &
+                       diss_l_e(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
+
+             IF ( humidity  .OR.  passive_scalar )  THEN
+                ALLOCATE( flux_s_q(nzb+1:nzt,0:threads_per_task-1),            &
+                          diss_s_q(nzb+1:nzt,0:threads_per_task-1) )
+                ALLOCATE( flux_l_q(nzb+1:nzt,nys:nyn,0:threads_per_task-1),    &
+                          diss_l_q(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
+             ENDIF
+
+             IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
+                ALLOCATE( flux_s_qr(nzb+1:nzt,0:threads_per_task-1),           &
+                          diss_s_qr(nzb+1:nzt,0:threads_per_task-1),           &
+                          flux_s_nr(nzb+1:nzt,0:threads_per_task-1),           &
+                          diss_s_nr(nzb+1:nzt,0:threads_per_task-1) )
+                ALLOCATE( flux_l_qr(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
+                          diss_l_qr(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
+                          flux_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
+                          diss_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 
+             ENDIF
+
+             IF ( ocean )  THEN
+                ALLOCATE( flux_s_sa(nzb+1:nzt,0:threads_per_task-1),           &
+                          diss_s_sa(nzb+1:nzt,0:threads_per_task-1) )
+                ALLOCATE( flux_l_sa(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
+                          diss_l_sa(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
+             ENDIF
+
+          ENDIF
+
+       ENDIF
+
+    END SUBROUTINE ws_init
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Initialize variables used for storing statistic quantities (fluxes, variances)
+!------------------------------------------------------------------------------!
+    SUBROUTINE ws_statistics
+    
+       USE control_parameters,                                                 &
+           ONLY:  cloud_physics, humidity, passive_scalar, ocean,              &
+                  microphysics_seifert, ws_scheme_mom, ws_scheme_sca
+
+       USE kinds
+
+       USE statistics,                                                         &
+           ONLY:  sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wsnrs_ws_l,&
+                  sums_wspts_ws_l, sums_wsqrs_ws_l, sums_wsqs_ws_l,            &
+                  sums_wssas_ws_l,  sums_wsus_ws_l, sums_wsvs_ws_l  
+
+       IMPLICIT NONE
+
+!       
+!--    The arrays needed for statistical evaluation are set to to 0 at the 
+!--    beginning of prognostic_equations.
+       IF ( ws_scheme_mom )  THEN
+          sums_wsus_ws_l = 0.0_wp
+          sums_wsvs_ws_l = 0.0_wp
+          sums_us2_ws_l  = 0.0_wp
+          sums_vs2_ws_l  = 0.0_wp
+          sums_ws2_ws_l  = 0.0_wp
+       ENDIF
+
+       IF ( ws_scheme_sca )  THEN
+          sums_wspts_ws_l = 0.0_wp
+          IF ( humidity  .OR.  passive_scalar )  sums_wsqs_ws_l = 0.0_wp
+          IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
+             sums_wsqrs_ws_l = 0.0_wp
+             sums_wsnrs_ws_l = 0.0_wp
+          ENDIF
+          IF ( ocean )  sums_wssas_ws_l = 0.0_wp
+
+       ENDIF
+
+    END SUBROUTINE ws_statistics
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Scalar advection - Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_s_ws_ij( i, j, sk, sk_char, swap_flux_y_local,            &
+                              swap_diss_y_local, swap_flux_x_local,            &
+                              swap_diss_x_local, i_omp, tn )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE constants,                                                          &
+           ONLY:  adv_sca_1, adv_sca_3, adv_sca_5
+
+       USE control_parameters,                                                 &
+           ONLY:  intermediate_timestep_count, monotonic_adjustment, u_gtrans, &
+                  v_gtrans 
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max,    &
+                  nzt, wall_flags_0
+
+       USE kinds
+
+       USE pegrid
+
+       USE statistics,                                                         &
+           ONLY:  sums_wsnrs_ws_l, sums_wspts_ws_l, sums_wsqrs_ws_l,           &
+                  sums_wsqs_ws_l, sums_wssas_ws_l, weight_substep
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN = *), INTENT(IN) ::  sk_char !<
+       
+       INTEGER(iwp) ::  i     !<
+       INTEGER(iwp) ::  ibit0 !<
+       INTEGER(iwp) ::  ibit1 !<
+       INTEGER(iwp) ::  ibit2 !<
+       INTEGER(iwp) ::  ibit3 !<
+       INTEGER(iwp) ::  ibit4 !<
+       INTEGER(iwp) ::  ibit5 !<
+       INTEGER(iwp) ::  ibit6 !<
+       INTEGER(iwp) ::  ibit7 !<
+       INTEGER(iwp) ::  ibit8 !<
+       INTEGER(iwp) ::  i_omp !<
+       INTEGER(iwp) ::  j     !<
+       INTEGER(iwp) ::  k     !<
+       INTEGER(iwp) ::  k_mm  !<
+       INTEGER(iwp) ::  k_mmm !<
+       INTEGER(iwp) ::  k_pp  !<
+       INTEGER(iwp) ::  k_ppp !<
+       INTEGER(iwp) ::  tn    !<
+       
+       REAL(wp)     ::  diss_d !<
+       REAL(wp)     ::  div    !<
+       REAL(wp)     ::  flux_d !<
+       REAL(wp)     ::  fd_1   !<
+       REAL(wp)     ::  fl_1   !<
+       REAL(wp)     ::  fn_1   !<
+       REAL(wp)     ::  fr_1   !<
+       REAL(wp)     ::  fs_1   !<
+       REAL(wp)     ::  ft_1   !<
+       REAL(wp)     ::  phi_d  !<
+       REAL(wp)     ::  phi_l  !<
+       REAL(wp)     ::  phi_n  !<
+       REAL(wp)     ::  phi_r  !<
+       REAL(wp)     ::  phi_s  !<
+       REAL(wp)     ::  phi_t  !<
+       REAL(wp)     ::  rd     !<
+       REAL(wp)     ::  rl     !<
+       REAL(wp)     ::  rn     !<
+       REAL(wp)     ::  rr     !<
+       REAL(wp)     ::  rs     !<
+       REAL(wp)     ::  rt     !<
+       REAL(wp)     ::  u_comp !<
+       REAL(wp)     ::  v_comp !<
+       
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER    ::  sk     !<
+#endif
+       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_n !<
+       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_r !<
+       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_t !<
+       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_n !<
+       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_r !<
+       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_t !<
+       
+       REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_diss_y_local !<
+       REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_flux_y_local !<
+       
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_diss_x_local !<
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_flux_x_local !<
+       
+
+!
+!--    Compute southside fluxes of the respective PE bounds.
+       IF ( j == nys )  THEN
+!
+!--       Up to the top of the highest topography.
+          DO  k = nzb+1, nzb_max
+
+             ibit5 = IBITS(wall_flags_0(k,j-1,i),5,1)
+             ibit4 = IBITS(wall_flags_0(k,j-1,i),4,1)
+             ibit3 = IBITS(wall_flags_0(k,j-1,i),3,1)
+
+             v_comp                  = v(k,j,i) - v_gtrans
+             swap_flux_y_local(k,tn) = v_comp *         (                     &
+                                               ( 37.0_wp * ibit5 * adv_sca_5  &
+                                            +     7.0_wp * ibit4 * adv_sca_3  &
+                                            +              ibit3 * adv_sca_1  &
+                                               ) *                            &
+                                           ( sk(k,j,i)  + sk(k,j-1,i)     )   &
+                                         -     (  8.0_wp * ibit5 * adv_sca_5  &
+                                            +              ibit4 * adv_sca_3  &
+                                                ) *                           &
+                                           ( sk(k,j+1,i) + sk(k,j-2,i)    )   &
+                                         +     (           ibit5 * adv_sca_5  &
+                                               ) *                            &
+                                           ( sk(k,j+2,i) + sk(k,j-3,i)    )   &
+                                                        )
+
+             swap_diss_y_local(k,tn) = -ABS( v_comp ) * (                     &
+                                               ( 10.0_wp * ibit5 * adv_sca_5  &
+                                            +     3.0_wp * ibit4 * adv_sca_3  &
+                                            +              ibit3 * adv_sca_1  &
+                                               ) *                            &
+                                            ( sk(k,j,i)   - sk(k,j-1,i)  )    &
+                                        -      (  5.0_wp * ibit5 * adv_sca_5  &
+                                            +              ibit4 * adv_sca_3  &
+                                            ) *                               &
+                                            ( sk(k,j+1,i) - sk(k,j-2,i)  )    &
+                                        +      (           ibit5 * adv_sca_5  &
+                                               ) *                            &
+                                            ( sk(k,j+2,i) - sk(k,j-3,i)  )    &
+                                                        )
+
+          ENDDO
+!
+!--       Above to the top of the highest topography. No degradation necessary.
+          DO  k = nzb_max+1, nzt
+
+             v_comp                  = v(k,j,i) - v_gtrans
+             swap_flux_y_local(k,tn) = v_comp * (                             &
+                                    37.0_wp * ( sk(k,j,i)   + sk(k,j-1,i) )   &
+                                  -  8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) )   &
+                                  +           ( sk(k,j+2,i) + sk(k,j-3,i) )   &
+                                                ) * adv_sca_5
+              swap_diss_y_local(k,tn) = -ABS( v_comp ) * (                    &
+                                    10.0_wp * ( sk(k,j,i)   - sk(k,j-1,i) )   &
+                                  -  5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) )   &
+                                  +             sk(k,j+2,i) - sk(k,j-3,i)     &
+                                                         ) * adv_sca_5
+
+          ENDDO
+
+       ENDIF
+!
+!--    Compute leftside fluxes of the respective PE bounds.
+       IF ( i == i_omp )  THEN
+        
+          DO  k = nzb+1, nzb_max
+
+             ibit2 = IBITS(wall_flags_0(k,j,i-1),2,1)
+             ibit1 = IBITS(wall_flags_0(k,j,i-1),1,1)
+             ibit0 = IBITS(wall_flags_0(k,j,i-1),0,1)
+
+             u_comp                     = u(k,j,i) - u_gtrans
+             swap_flux_x_local(k,j,tn) = u_comp * (                           &
+                                               ( 37.0_wp * ibit2 * adv_sca_5  &
+                                            +     7.0_wp * ibit1 * adv_sca_3  &
+                                            +              ibit0 * adv_sca_1  &
+                                               ) *                            &
+                                            ( sk(k,j,i)   + sk(k,j,i-1)    )  &
+                                        -      (  8.0_wp * ibit2 * adv_sca_5  &
+                                            +              ibit1 * adv_sca_3  &
+                                               ) *                            &
+                                            ( sk(k,j,i+1) + sk(k,j,i-2)    )  &
+                                        +      (           ibit2 * adv_sca_5  &
+                                               ) *                            &
+                                            ( sk(k,j,i+2) + sk(k,j,i-3)    )  &
+                                                  )
+
+              swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * (                  &
+                                               ( 10.0_wp * ibit2 * adv_sca_5  &
+                                            +     3.0_wp * ibit1 * adv_sca_3  &
+                                            +              ibit0 * adv_sca_1  &
+                                               ) *                            &
+                                            ( sk(k,j,i)   - sk(k,j,i-1)    )  &
+                                        -      (  5.0_wp * ibit2 * adv_sca_5  &
+                                            +              ibit1 * adv_sca_3  &
+                                               ) *                            &
+                                            ( sk(k,j,i+1) - sk(k,j,i-2)    )  &
+                                        +      (           ibit2 * adv_sca_5  &
+                                               ) *                            &
+                                            ( sk(k,j,i+2) - sk(k,j,i-3)    )  &
+                                                           )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             u_comp                 = u(k,j,i) - u_gtrans
+             swap_flux_x_local(k,j,tn) = u_comp * (                           &
+                                      37.0_wp * ( sk(k,j,i)   + sk(k,j,i-1) ) &
+                                    -  8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) ) &
+                                    +           ( sk(k,j,i+2) + sk(k,j,i-3) ) &
+                                                  ) * adv_sca_5
+
+             swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * (                   &
+                                      10.0_wp * ( sk(k,j,i)   - sk(k,j,i-1) ) &
+                                    -  5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) ) &
+                                    +           ( sk(k,j,i+2) - sk(k,j,i-3) ) &
+                                                          ) * adv_sca_5
+
+          ENDDO
+           
+       ENDIF
+
+       flux_t(0) = 0.0_wp
+       diss_t(0) = 0.0_wp
+       flux_d    = 0.0_wp
+       diss_d    = 0.0_wp
+!        
+!--    Now compute the fluxes and tendency terms for the horizontal and
+!--    vertical parts up to the top of the highest topography.
+       DO  k = nzb+1, nzb_max
+!
+!--       Note: It is faster to conduct all multiplications explicitly, e.g.
+!--       * adv_sca_5 ... than to determine a factor and multiplicate the
+!--       flux at the end. 
+
+          ibit2 = IBITS(wall_flags_0(k,j,i),2,1)
+          ibit1 = IBITS(wall_flags_0(k,j,i),1,1)
+          ibit0 = IBITS(wall_flags_0(k,j,i),0,1)
+
+          u_comp    = u(k,j,i+1) - u_gtrans
+          flux_r(k) = u_comp * (                                              &
+                     ( 37.0_wp * ibit2 * adv_sca_5                            &
+                  +     7.0_wp * ibit1 * adv_sca_3                            &
+                  +              ibit0 * adv_sca_1                            &
+                     ) *                                                      &
+                             ( sk(k,j,i+1) + sk(k,j,i)   )                    &
+              -      (  8.0_wp * ibit2 * adv_sca_5                            &
+                  +              ibit1 * adv_sca_3                            &
+                     ) *                                                      &
+                             ( sk(k,j,i+2) + sk(k,j,i-1) )                    &
+              +      (           ibit2 * adv_sca_5                            &
+                     ) *                                                      &
+                             ( sk(k,j,i+3) + sk(k,j,i-2) )                    &
+                               )
+
+          diss_r(k) = -ABS( u_comp ) * (                                      &
+                     ( 10.0_wp * ibit2 * adv_sca_5                            &
+                  +     3.0_wp * ibit1 * adv_sca_3                            &
+                  +              ibit0 * adv_sca_1                            &
+                     ) *                                                      &
+                             ( sk(k,j,i+1) - sk(k,j,i)  )                     &
+              -      (  5.0_wp * ibit2 * adv_sca_5                            &
+                  +              ibit1 * adv_sca_3                            &
+                     ) *                                                      &
+                             ( sk(k,j,i+2) - sk(k,j,i-1) )                    &
+              +      (           ibit2 * adv_sca_5                            &
+                     ) *                                                      &
+                             ( sk(k,j,i+3) - sk(k,j,i-2) )                    &
+                                       )
+
+          ibit5 = IBITS(wall_flags_0(k,j,i),5,1)
+          ibit4 = IBITS(wall_flags_0(k,j,i),4,1)
+          ibit3 = IBITS(wall_flags_0(k,j,i),3,1)
+
+          v_comp    = v(k,j+1,i) - v_gtrans
+          flux_n(k) = v_comp * (                                              &
+                     ( 37.0_wp * ibit5 * adv_sca_5                            &
+                  +     7.0_wp * ibit4 * adv_sca_3                            &
+                  +              ibit3 * adv_sca_1                            &
+                     ) *                                                      &
+                             ( sk(k,j+1,i) + sk(k,j,i)   )                    &
+              -      (  8.0_wp * ibit5 * adv_sca_5                            &
+                  +              ibit4 * adv_sca_3                            &
+                     ) *                                                      &
+                             ( sk(k,j+2,i) + sk(k,j-1,i) )                    &
+              +      (           ibit5 * adv_sca_5                            &
+                     ) *                                                      &
+                             ( sk(k,j+3,i) + sk(k,j-2,i) )                    &
+                               )
+
+          diss_n(k) = -ABS( v_comp ) * (                                      &
+                     ( 10.0_wp * ibit5 * adv_sca_5                            &
+                  +     3.0_wp * ibit4 * adv_sca_3                            &
+                  +              ibit3 * adv_sca_1                            &
+                     ) *                                                      &
+                             ( sk(k,j+1,i) - sk(k,j,i)   )                    &
+              -      (  5.0_wp * ibit5 * adv_sca_5                            &
+                  +              ibit4 * adv_sca_3                            &
+                     ) *                                                      &
+                             ( sk(k,j+2,i) - sk(k,j-1,i) )                    &
+              +      (           ibit5 * adv_sca_5                            &
+                     ) *                                                      &
+                             ( sk(k,j+3,i) - sk(k,j-2,i) )                    &
+                                       )
+!
+!--       k index has to be modified near bottom and top, else array
+!--       subscripts will be exceeded.
+          ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
+          ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
+          ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
+
+          k_ppp = k + 3 * ibit8
+          k_pp  = k + 2 * ( 1 - ibit6  )
+          k_mm  = k - 2 * ibit8
+
+
+          flux_t(k) = w(k,j,i) * (                                            &
+                     ( 37.0_wp * ibit8 * adv_sca_5                            &
+                  +     7.0_wp * ibit7 * adv_sca_3                            &
+                  +              ibit6 * adv_sca_1                            &
+                     ) *                                                      &
+                             ( sk(k+1,j,i)  + sk(k,j,i)    )                  &
+              -      (  8.0_wp * ibit8 * adv_sca_5                            &
+                  +              ibit7 * adv_sca_3                            &
+                     ) *                                                      &
+                             ( sk(k_pp,j,i) + sk(k-1,j,i)  )                  &
+              +      (           ibit8 * adv_sca_5                            &
+                     ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )                  &
+                                 )
+
+          diss_t(k) = -ABS( w(k,j,i) ) * (                                    &
+                     ( 10.0_wp * ibit8 * adv_sca_5                            &
+                  +     3.0_wp * ibit7 * adv_sca_3                            &
+                  +              ibit6 * adv_sca_1                            &
+                     ) *                                                      &
+                             ( sk(k+1,j,i)   - sk(k,j,i)    )                 &
+              -      (  5.0_wp * ibit8 * adv_sca_5                            &
+                  +              ibit7 * adv_sca_3                            &
+                     ) *                                                      &
+                             ( sk(k_pp,j,i)  - sk(k-1,j,i)  )                 &
+              +      (           ibit8 * adv_sca_5                            &
+                     ) *                                                      &
+                             ( sk(k_ppp,j,i) - sk(k_mm,j,i) )                 &
+                                         )
+!
+!--       Apply monotonic adjustment.
+          IF ( monotonic_adjustment )  THEN
+!
+!--          At first, calculate first order fluxes.
+             u_comp = u(k,j,i) - u_gtrans
+             fl_1   =  ( u_comp   * ( sk(k,j,i) + sk(k,j,i-1) )               &
+                   -ABS( u_comp ) * ( sk(k,j,i) - sk(k,j,i-1) )               &
+                       ) * adv_sca_1 
+
+             u_comp = u(k,j,i+1) - u_gtrans
+             fr_1   =  ( u_comp   * ( sk(k,j,i+1) + sk(k,j,i) )               &
+                   -ABS( u_comp ) * ( sk(k,j,i+1) - sk(k,j,i) )               &
+                       ) * adv_sca_1 
+
+             v_comp = v(k,j,i) - v_gtrans
+             fs_1   =  ( v_comp   * ( sk(k,j,i) + sk(k,j-1,i) )               &
+                   -ABS( v_comp ) * ( sk(k,j,i) - sk(k,j-1,i) )               &
+                       ) * adv_sca_1 
+
+             v_comp = v(k,j+1,i) - v_gtrans
+             fn_1   =  ( v_comp   * ( sk(k,j+1,i) + sk(k,j,i) )               &
+                   -ABS( v_comp ) * ( sk(k,j+1,i) - sk(k,j,i) )               &
+                       ) * adv_sca_1 
+
+             fd_1   =  ( w(k-1,j,i)   * ( sk(k,j,i) + sk(k-1,j,i) )           &
+                   -ABS( w(k-1,j,i) ) * ( sk(k,j,i) - sk(k-1,j,i) )           &
+                       ) * adv_sca_1 
+
+             ft_1   =  ( w(k,j,i)   * ( sk(k+1,j,i) + sk(k,j,i) )             &
+                   -ABS( w(k,j,i) ) * ( sk(k+1,j,i) - sk(k,j,i) )             &
+                      ) * adv_sca_1 
+!
+!--          Calculate ratio of upwind gradients. Note, Min/Max is just to 
+!--          avoid if statements.
+             rl     = ( MAX( 0.0_wp, u(k,j,i) - u_gtrans ) *                  & 
+                           ABS( ( sk(k,j,i-1) - sk(k,j,i-2)            ) /    &
+                                ( sk(k,j,i)   - sk(k,j,i-1) + 1E-20_wp )      &
+                              ) +                                             & 
+                        MIN( 0.0_wp, u(k,j,i) - u_gtrans ) *                  &
+                           ABS( ( sk(k,j,i)   - sk(k,j,i+1)            ) /    &
+                                ( sk(k,j,i-1) - sk(k,j,i)   + 1E-20_wp )      &
+                              )                                               &
+                      ) / ABS( u(k,j,i) - u_gtrans + 1E-20_wp )
+
+             rr     = ( MAX( 0.0_wp, u(k,j,i+1) - u_gtrans ) *                & 
+                           ABS( ( sk(k,j,i)   - sk(k,j,i-1)            ) /    &
+                                ( sk(k,j,i+1) - sk(k,j,i)   + 1E-20_wp )      &
+                              ) +                                             & 
+                        MIN( 0.0_wp, u(k,j,i+1) - u_gtrans ) *                &
+                           ABS( ( sk(k,j,i+1) - sk(k,j,i+2)            ) /    &
+                                ( sk(k,j,i)   - sk(k,j,i+1) + 1E-20_wp )      &
+                              )                                               &
+                      ) / ABS( u(k,j,i+1) - u_gtrans + 1E-20_wp )
+
+             rs     = ( MAX( 0.0_wp, v(k,j,i) - v_gtrans ) *                  & 
+                           ABS( ( sk(k,j-1,i) - sk(k,j-2,i)            ) /    &
+                                ( sk(k,j,i)   - sk(k,j-1,i) + 1E-20_wp )      &
+                              ) +                                             & 
+                        MIN( 0.0_wp, v(k,j,i) - v_gtrans ) *                  &
+                           ABS( ( sk(k,j,i)   - sk(k,j+1,i)            ) /    &
+                                ( sk(k,j-1,i) - sk(k,j,i)   + 1E-20_wp )      &
+                              )                                               &
+                      ) / ABS( v(k,j,i) - v_gtrans + 1E-20_wp )
+
+             rn     = ( MAX( 0.0_wp, v(k,j+1,i) - v_gtrans ) *                & 
+                           ABS( ( sk(k,j,i)   - sk(k,j-1,i)            ) /    &
+                                ( sk(k,j+1,i) - sk(k,j,i)   + 1E-20_wp )      &
+                              ) +                                             & 
+                       MIN( 0.0_wp, v(k,j+1,i) - v_gtrans ) *                 &
+                           ABS( ( sk(k,j+1,i) - sk(k,j+2,i)            ) /    &
+                                ( sk(k,j,i)   - sk(k,j+1,i) + 1E-20_wp )      &
+                              )                                               &
+                      ) / ABS( v(k,j+1,i) - v_gtrans + 1E-20_wp )     
+!   
+!--          Reuse k_mm and compute k_mmm for the vertical gradient ratios. 
+!--          Note, for vertical advection below the third grid point above 
+!--          surface ( or below the model top) rd and rt are set to 0, i.e. 
+!--          use of first order scheme is enforced.
+             k_mmm  = k - 3 * ibit8
+
+             rd     = ( MAX( 0.0_wp, w(k-1,j,i) ) *                           & 
+                           ABS( ( sk(k_mm,j,i) - sk(k_mmm,j,i)           ) /  &
+                                ( sk(k-1,j,i)  - sk(k_mm,j,i) + 1E-20_wp )    &
+                              ) +                                             & 
+                        MIN( 0.0_wp, w(k-1,j,i) ) *                           &
+                           ABS( ( sk(k-1,j,i) - sk(k,j,i)            ) /      &
+                                ( sk(k_mm,j,i) - sk(k-1,j,i)   + 1E-20_wp )   &
+                              )                                               &
+                      ) * ibit8 / ABS( w(k-1,j,i) + 1E-20_wp ) 
+ 
+             rt     = ( MAX( 0.0_wp, w(k,j,i) ) *                             & 
+                           ABS( ( sk(k,j,i)   - sk(k-1,j,i)            ) /    &
+                                ( sk(k+1,j,i) - sk(k,j,i)   + 1E-20_wp )      &
+                              ) +                                             & 
+                        MIN( 0.0_wp, w(k,j,i) ) *                             &
+                           ABS( ( sk(k+1,j,i) - sk(k_pp,j,i)           ) /    &
+                                ( sk(k,j,i)   - sk(k+1,j,i) + 1E-20_wp )      &
+                              )                                               &
+                      ) * ibit8 / ABS( w(k,j,i) + 1E-20_wp )
+!
+!--           Calculate empirical limiter function (van Albada2 limiter).
+              phi_l = MIN( 1.0_wp, ( 2.0_wp * ABS( rl ) ) /                   &
+                                         ( rl**2 + 1.0_wp ) ) 
+              phi_r = MIN( 1.0_wp, ( 2.0_wp * ABS( rr ) ) /                   &
+                                         ( rr**2 + 1.0_wp ) ) 
+              phi_s = MIN( 1.0_wp, ( 2.0_wp * ABS( rs ) ) /                   &
+                                         ( rs**2 + 1.0_wp ) ) 
+              phi_n = MIN( 1.0_wp, ( 2.0_wp * ABS( rn ) ) /                   &
+                                         ( rn**2 + 1.0_wp ) ) 
+              phi_d = MIN( 1.0_wp, ( 2.0_wp * ABS( rd ) ) /                   &
+                                         ( rd**2 + 1.0_wp ) ) 
+              phi_t = MIN( 1.0_wp, ( 2.0_wp * ABS( rt ) ) /                   &
+                                         ( rt**2 + 1.0_wp ) ) 
+!
+!--           Calculate the resulting monotone flux. 
+              swap_flux_x_local(k,j,tn) = fl_1 - phi_l *                      &
+                                        ( fl_1 - swap_flux_x_local(k,j,tn)  )
+              flux_r(k)                 = fr_1 - phi_r *                      &
+                                        ( fr_1 - flux_r(k)                  )
+              swap_flux_y_local(k,tn)   = fs_1 - phi_s *                      &
+                                        ( fs_1 - swap_flux_y_local(k,tn)    )
+              flux_n(k)                 = fn_1 - phi_n *                      &
+                                        ( fn_1 - flux_n(k)                  )
+              flux_d                    = fd_1 - phi_d *                      &
+                                        ( fd_1 - flux_d                     )
+              flux_t(k)                 = ft_1 - phi_t *                      &
+                                        ( ft_1 - flux_t(k)                  )
+!
+!--          Moreover, modify dissipation flux according to the limiter. 
+             swap_diss_x_local(k,j,tn) = swap_diss_x_local(k,j,tn) * phi_l
+             diss_r(k)                 = diss_r(k)                 * phi_r
+             swap_diss_y_local(k,tn)   = swap_diss_y_local(k,tn)   * phi_s
+             diss_n(k)                 = diss_n(k)                 * phi_n
+             diss_d                    = diss_d                    * phi_d
+             diss_t(k)                 = diss_t(k)                 * phi_t
+
+          ENDIF
+!
+!--       Calculate the divergence of the velocity field. A respective
+!--       correction is needed to overcome numerical instabilities caused
+!--       by a not sufficient reduction of divergences near topography. 
+          div         =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )             &
+                          - u(k,j,i)   * ( IBITS(wall_flags_0(k,j,i-1),0,1)    &
+                                         + IBITS(wall_flags_0(k,j,i-1),1,1)    &
+                                         + IBITS(wall_flags_0(k,j,i-1),2,1)    &
+                                         )                                     &
+                          ) * ddx                                              &
+                        + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )             &
+                          - v(k,j,i)   * ( IBITS(wall_flags_0(k,j-1,i),3,1)    &
+                                         + IBITS(wall_flags_0(k,j-1,i),4,1)    &
+                                         + IBITS(wall_flags_0(k,j-1,i),5,1)    &
+                                         )                                     &
+                          ) * ddy                                              &
+                        + ( w(k,j,i)   * ( ibit6 + ibit7 + ibit8 )             &
+                          - w(k-1,j,i) * ( IBITS(wall_flags_0(k-1,j,i),6,1)    &
+                                         + IBITS(wall_flags_0(k-1,j,i),7,1)    &
+                                         + IBITS(wall_flags_0(k-1,j,i),8,1)    &
+                                         )                                     &      
+                          ) * ddzw(k)
+
+
+          tend(k,j,i) = tend(k,j,i) - (                                       &
+                        ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j,tn) - &
+                          swap_diss_x_local(k,j,tn)            ) * ddx        &
+                      + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k,tn)   - &
+                          swap_diss_y_local(k,tn)              ) * ddy        &
+                      + ( flux_t(k) + diss_t(k) - flux_d - diss_d             &
+                                                               ) * ddzw(k)    &
+                                      ) + sk(k,j,i) * div
+
+          swap_flux_y_local(k,tn)   = flux_n(k)
+          swap_diss_y_local(k,tn)   = diss_n(k)
+          swap_flux_x_local(k,j,tn) = flux_r(k)
+          swap_diss_x_local(k,j,tn) = diss_r(k)
+          flux_d                    = flux_t(k)
+          diss_d                    = diss_t(k)
+
+       ENDDO
+!
+!--    Now compute the fluxes and tendency terms for the horizontal and
+!--    vertical parts above the top of the highest topography. No degradation
+!--    for the horizontal parts, but for the vertical it is stell needed.
+       DO  k = nzb_max+1, nzt
+
+          u_comp    = u(k,j,i+1) - u_gtrans
+          flux_r(k) = u_comp * (                                              &
+                      37.0_wp * ( sk(k,j,i+1) + sk(k,j,i)   )                 &
+                    -  8.0_wp * ( sk(k,j,i+2) + sk(k,j,i-1) )                 &
+                    +           ( sk(k,j,i+3) + sk(k,j,i-2) ) ) * adv_sca_5
+          diss_r(k) = -ABS( u_comp ) * (                                      &
+                      10.0_wp * ( sk(k,j,i+1) - sk(k,j,i)   )                 &
+                    -  5.0_wp * ( sk(k,j,i+2) - sk(k,j,i-1) )                 &
+                    +           ( sk(k,j,i+3) - sk(k,j,i-2) ) ) * adv_sca_5
+
+          v_comp    = v(k,j+1,i) - v_gtrans
+          flux_n(k) = v_comp * (                                              &
+                      37.0_wp * ( sk(k,j+1,i) + sk(k,j,i)   )                 &
+                    -  8.0_wp * ( sk(k,j+2,i) + sk(k,j-1,i) )                 &
+                    +           ( sk(k,j+3,i) + sk(k,j-2,i) ) ) * adv_sca_5
+          diss_n(k) = -ABS( v_comp ) * (                                      &
+                      10.0_wp * ( sk(k,j+1,i) - sk(k,j,i)   )                 &
+                    -  5.0_wp * ( sk(k,j+2,i) - sk(k,j-1,i) )                 &
+                    +           ( sk(k,j+3,i) - sk(k,j-2,i) ) ) * adv_sca_5
+!
+!--       k index has to be modified near bottom and top, else array
+!--       subscripts will be exceeded.
+          ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
+          ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
+          ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
+
+          k_ppp = k + 3 * ibit8
+          k_pp  = k + 2 * ( 1 - ibit6  )
+          k_mm  = k - 2 * ibit8
+
+          flux_t(k) = w(k,j,i) * (                                            &
+                    ( 37.0_wp * ibit8 * adv_sca_5                             &
+                 +     7.0_wp * ibit7 * adv_sca_3                             &
+                 +              ibit6 * adv_sca_1                             &
+                    ) *                                                       &
+                             ( sk(k+1,j,i)  + sk(k,j,i)   )                   &
+              -     (  8.0_wp * ibit8 * adv_sca_5                             &
+                  +              ibit7 * adv_sca_3                            &
+                    ) *                                                       &
+                             ( sk(k_pp,j,i) + sk(k-1,j,i) )                   &
+              +     (           ibit8 * adv_sca_5                             &
+                    ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )                   &
+                                 )
+
+          diss_t(k) = -ABS( w(k,j,i) ) * (                                    &
+                    ( 10.0_wp * ibit8 * adv_sca_5                             &
+                 +     3.0_wp * ibit7 * adv_sca_3                             &
+                 +              ibit6 * adv_sca_1                             &
+                    ) *                                                       &
+                             ( sk(k+1,j,i)   - sk(k,j,i)    )                 &
+              -     (  5.0_wp * ibit8 * adv_sca_5                             &
+                 +              ibit7 * adv_sca_3                             &
+                    ) *                                                       &
+                             ( sk(k_pp,j,i)  - sk(k-1,j,i)  )                 &
+              +     (           ibit8 * adv_sca_5                             &
+                    ) *                                                       &
+                             ( sk(k_ppp,j,i) - sk(k_mm,j,i) )                 &
+                                         )
+
+
+!
+!--       Apply monotonic adjustment.
+          IF ( monotonic_adjustment )  THEN
+!
+!--          At first, calculate first order fluxes.
+             u_comp = u(k,j,i) - u_gtrans
+             fl_1   =  ( u_comp   * ( sk(k,j,i) + sk(k,j,i-1) )               &
+                   -ABS( u_comp ) * ( sk(k,j,i) - sk(k,j,i-1) )               &
+                       ) * adv_sca_1 
+
+             u_comp = u(k,j,i+1) - u_gtrans
+             fr_1   =  ( u_comp   * ( sk(k,j,i+1) + sk(k,j,i) )               &
+                   -ABS( u_comp ) * ( sk(k,j,i+1) - sk(k,j,i) )               &
+                       ) * adv_sca_1 
+
+             v_comp = v(k,j,i) - v_gtrans
+             fs_1   =  ( v_comp   * ( sk(k,j,i) + sk(k,j-1,i) )               &
+                   -ABS( v_comp ) * ( sk(k,j,i) - sk(k,j-1,i) )               &
+                       ) * adv_sca_1 
+
+             v_comp = v(k,j+1,i) - v_gtrans
+             fn_1   =  ( v_comp   * ( sk(k,j+1,i) + sk(k,j,i) )               &
+                   -ABS( v_comp ) * ( sk(k,j+1,i) - sk(k,j,i) )               &
+                       ) * adv_sca_1 
+
+             fd_1   =  ( w(k-1,j,i)   * ( sk(k,j,i) + sk(k-1,j,i) )           &
+                   -ABS( w(k-1,j,i) ) * ( sk(k,j,i) - sk(k-1,j,i) )           &
+                       ) * adv_sca_1 
+
+             ft_1   =  ( w(k,j,i)   * ( sk(k+1,j,i) + sk(k,j,i) )             &
+                   -ABS( w(k,j,i) ) * ( sk(k+1,j,i) - sk(k,j,i) )             &
+                       ) * adv_sca_1 
+!
+!--          Calculate ratio of upwind gradients. Note, Min/Max is just to 
+!--          avoid if statements. 
+             rl     = ( MAX( 0.0_wp, u(k,j,i) - u_gtrans ) *                  & 
+                           ABS( ( sk(k,j,i-1) - sk(k,j,i-2)            ) /    &
+                                ( sk(k,j,i)   - sk(k,j,i-1) + 1E-20_wp )      &
+                              ) +                                             & 
+                        MIN( 0.0_wp, u(k,j,i) - u_gtrans ) *                  &
+                           ABS( ( sk(k,j,i)   - sk(k,j,i+1)            ) /    &
+                                ( sk(k,j,i-1) - sk(k,j,i)   + 1E-20_wp )      &
+                              )                                               &
+                      ) / ABS( u(k,j,i) - u_gtrans + 1E-20_wp )
+
+             rr     = ( MAX( 0.0_wp, u(k,j,i+1) - u_gtrans ) *                & 
+                           ABS( ( sk(k,j,i)   - sk(k,j,i-1)            ) /    &
+                                ( sk(k,j,i+1) - sk(k,j,i)   + 1E-20_wp )      &
+                              ) +                                             & 
+                        MIN( 0.0_wp, u(k,j,i+1) - u_gtrans ) *                &
+                           ABS( ( sk(k,j,i+1) - sk(k,j,i+2)            ) /    &
+                                ( sk(k,j,i)   - sk(k,j,i+1) + 1E-20_wp )      &
+                              )                                               &
+                      ) / ABS( u(k,j,i+1) - u_gtrans + 1E-20_wp )
+
+             rs     = ( MAX( 0.0_wp, v(k,j,i) - v_gtrans ) *                  & 
+                           ABS( ( sk(k,j-1,i) - sk(k,j-2,i)            ) /    &
+                                ( sk(k,j,i)   - sk(k,j-1,i) + 1E-20_wp )      &
+                              ) +                                             & 
+                        MIN( 0.0_wp, v(k,j,i) - v_gtrans ) *                  &
+                           ABS( ( sk(k,j,i)   - sk(k,j+1,i)            ) /    &
+                                ( sk(k,j-1,i) - sk(k,j,i)   + 1E-20_wp )      &
+                              )                                               &
+                      ) / ABS( v(k,j,i) - v_gtrans + 1E-20_wp )
+
+             rn     = ( MAX( 0.0_wp, v(k,j+1,i) - v_gtrans ) *                & 
+                           ABS( ( sk(k,j,i)   - sk(k,j-1,i)            ) /    &
+                                ( sk(k,j+1,i) - sk(k,j,i)   + 1E-20_wp )      &
+                              ) +                                             & 
+                       MIN( 0.0_wp, v(k,j+1,i) - v_gtrans ) *                 &
+                           ABS( ( sk(k,j+1,i) - sk(k,j+2,i)            ) /    &
+                                ( sk(k,j,i)   - sk(k,j+1,i) + 1E-20_wp )      &
+                              )                                               &
+                      ) / ABS( v(k,j+1,i) - v_gtrans + 1E-20_wp )     
+!
+!--          Reuse k_mm and compute k_mmm for the vertical gradient ratios. 
+!--          Note, for vertical advection below the third grid point above 
+!--          surface ( or below the model top) rd and rt are set to 0, i.e. 
+!--          use of first order scheme is enforced.
+             k_mmm  = k - 3 * ibit8
+
+             rd     = ( MAX( 0.0_wp, w(k-1,j,i) ) *                           & 
+                           ABS( ( sk(k_mm,j,i) - sk(k_mmm,j,i)           ) /  &
+                                ( sk(k-1,j,i)  - sk(k_mm,j,i) + 1E-20_wp )    &
+                              ) +                                             & 
+                        MIN( 0.0_wp, w(k-1,j,i) ) *                           &
+                           ABS( ( sk(k-1,j,i) - sk(k,j,i)            ) /      &
+                                ( sk(k_mm,j,i) - sk(k-1,j,i)   + 1E-20_wp )   &
+                              )                                               &
+                      ) * ibit8 / ABS( w(k-1,j,i) + 1E-20_wp ) 
+ 
+             rt     = ( MAX( 0.0_wp, w(k,j,i) ) *                             & 
+                           ABS( ( sk(k,j,i)   - sk(k-1,j,i)            ) /    &
+                                ( sk(k+1,j,i) - sk(k,j,i)   + 1E-20_wp )      &
+                              ) +                                             & 
+                        MIN( 0.0_wp, w(k,j,i) ) *                             &
+                           ABS( ( sk(k+1,j,i) - sk(k_pp,j,i)           ) /    &
+                                ( sk(k,j,i)   - sk(k+1,j,i) + 1E-20_wp )      &
+                              )                                               &
+                      ) * ibit8 / ABS( w(k,j,i) + 1E-20_wp ) 
+!
+!--           Calculate empirical limiter function (van Albada2 limiter).
+              phi_l = MIN( 1.0_wp, ( 2.0_wp * ABS( rl ) ) /                   &
+                                         ( rl**2 + 1.0_wp ) ) 
+              phi_r = MIN( 1.0_wp, ( 2.0_wp * ABS( rr ) ) /                   &
+                                         ( rr**2 + 1.0_wp ) ) 
+              phi_s = MIN( 1.0_wp, ( 2.0_wp * ABS( rs ) ) /                   &
+                                         ( rs**2 + 1.0_wp ) ) 
+              phi_n = MIN( 1.0_wp, ( 2.0_wp * ABS( rn ) ) /                   &
+                                         ( rn**2 + 1.0_wp ) ) 
+              phi_d = MIN( 1.0_wp, ( 2.0_wp * ABS( rd ) ) /                   &
+                                         ( rd**2 + 1.0_wp ) ) 
+              phi_t = MIN( 1.0_wp, ( 2.0_wp * ABS( rt ) ) /                   &
+                                         ( rt**2 + 1.0_wp ) ) 
+!
+!--           Calculate the resulting monotone flux. 
+              swap_flux_x_local(k,j,tn) = fl_1 - phi_l *                      &
+                                        ( fl_1 - swap_flux_x_local(k,j,tn)  )
+              flux_r(k)                 = fr_1 - phi_r *                      &
+                                        ( fr_1 - flux_r(k)                  )
+              swap_flux_y_local(k,tn)   = fs_1 - phi_s *                      &
+                                        ( fs_1 - swap_flux_y_local(k,tn)    )
+              flux_n(k)                 = fn_1 - phi_n *                      &
+                                        ( fn_1 - flux_n(k)                  )
+              flux_d                    = fd_1 - phi_d *                      &
+                                        ( fd_1 - flux_d                     )
+              flux_t(k)                 = ft_1 - phi_t *                      &
+                                        ( ft_1 - flux_t(k)                  )
+!
+!--          Moreover, modify dissipation flux according to the limiter. 
+             swap_diss_x_local(k,j,tn) = swap_diss_x_local(k,j,tn) * phi_l
+             diss_r(k)                 = diss_r(k)                 * phi_r
+             swap_diss_y_local(k,tn)   = swap_diss_y_local(k,tn)   * phi_s
+             diss_n(k)                 = diss_n(k)                 * phi_n
+             diss_d                    = diss_d                    * phi_d
+             diss_t(k)                 = diss_t(k)                 * phi_t
+
+          ENDIF
+!
+!--       Calculate the divergence of the velocity field. A respective
+!--       correction is needed to overcome numerical instabilities introduced
+!--       by a not sufficient reduction of divergences near topography.
+          div         =   ( u(k,j,i+1) - u(k,j,i)   ) * ddx                   &
+                        + ( v(k,j+1,i) - v(k,j,i)   ) * ddy                   &
+                        + ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)
+
+          tend(k,j,i) = tend(k,j,i) - (                                       &
+                        ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j,tn) - &
+                          swap_diss_x_local(k,j,tn)            ) * ddx        &
+                      + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k,tn)   - &
+                          swap_diss_y_local(k,tn)              ) * ddy        &
+                      + ( flux_t(k) + diss_t(k) - flux_d - diss_d             &
+                                                               ) * ddzw(k)    &
+                                      ) + sk(k,j,i) * div
+
+
+          swap_flux_y_local(k,tn)   = flux_n(k)
+          swap_diss_y_local(k,tn)   = diss_n(k)
+          swap_flux_x_local(k,j,tn) = flux_r(k)
+          swap_diss_x_local(k,j,tn) = diss_r(k)
+          flux_d                    = flux_t(k)
+          diss_d                    = diss_t(k)
+
+       ENDDO
+
+!
+!--    Evaluation of statistics.
+       SELECT CASE ( sk_char )
+
+          CASE ( 'pt' )
+
+             DO  k = nzb, nzt
+                sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn) +               &
+                                       ( flux_t(k) + diss_t(k) )              &
+                               * weight_substep(intermediate_timestep_count)
+             ENDDO
+            
+          CASE ( 'sa' )
+
+             DO  k = nzb, nzt
+                sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn) +               &
+                                       ( flux_t(k) + diss_t(k) )              &
+                               * weight_substep(intermediate_timestep_count)
+             ENDDO
+            
+          CASE ( 'q' )
+
+             DO  k = nzb, nzt
+                sums_wsqs_ws_l(k,tn)  = sums_wsqs_ws_l(k,tn) +                &
+                                      ( flux_t(k) + diss_t(k) )               &
+                               * weight_substep(intermediate_timestep_count)
+             ENDDO
+
+          CASE ( 'qr' )
+
+             DO  k = nzb, nzt
+                sums_wsqrs_ws_l(k,tn)  = sums_wsqrs_ws_l(k,tn) +              &
+                                      ( flux_t(k) + diss_t(k) )               &
+                               * weight_substep(intermediate_timestep_count)
+             ENDDO
+
+          CASE ( 'nr' )
+
+             DO  k = nzb, nzt
+                sums_wsnrs_ws_l(k,tn)  = sums_wsnrs_ws_l(k,tn) +              &
+                                      ( flux_t(k) + diss_t(k) )               &
+                               * weight_substep(intermediate_timestep_count)
+             ENDDO
+
+         END SELECT
+         
+    END SUBROUTINE advec_s_ws_ij
+
+
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Advection of u-component - Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_u_ws_ij( i, j, i_omp, tn )
+
+       USE arrays_3d,                                                         &
+           ONLY:  ddzw, diss_l_u, diss_s_u, flux_l_u, flux_s_u, tend, u, v, w
+
+       USE constants,                                                         &
+           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
+
+       USE control_parameters,                                                &
+           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
+
+       USE grid_variables,                                                    &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                           &
+           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0
+
+       USE kinds
+
+       USE statistics,                                                        &
+           ONLY:  hom, sums_us2_ws_l, sums_wsus_ws_l, weight_substep
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  ibit9  !<
+       INTEGER(iwp) ::  ibit10 !<
+       INTEGER(iwp) ::  ibit11 !<
+       INTEGER(iwp) ::  ibit12 !<
+       INTEGER(iwp) ::  ibit13 !<
+       INTEGER(iwp) ::  ibit14 !<
+       INTEGER(iwp) ::  ibit15 !<
+       INTEGER(iwp) ::  ibit16 !<
+       INTEGER(iwp) ::  ibit17 !<
+       INTEGER(iwp) ::  i_omp  !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  k      !<
+       INTEGER(iwp) ::  k_mm   !<
+       INTEGER(iwp) ::  k_pp   !<
+       INTEGER(iwp) ::  k_ppp  !<
+       INTEGER(iwp) ::  tn     !<
+       
+       REAL(wp)    ::  diss_d   !<
+       REAL(wp)    ::  div      !<
+       REAL(wp)    ::  flux_d   !<
+       REAL(wp)    ::  gu       !<
+       REAL(wp)    ::  gv       !<
+       REAL(wp)    ::  u_comp_l !<
+       REAL(wp)    ::  v_comp   !<
+       REAL(wp)    ::  w_comp   !<
+       
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_n !<
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_r !<
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_t !<
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_n !<
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_r !<
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_t !<
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  u_comp !<
+
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+!
+!--    Compute southside fluxes for the respective boundary of PE
+       IF ( j == nys  )  THEN
+       
+          DO  k = nzb+1, nzb_max
+
+             ibit14 = IBITS(wall_flags_0(k,j-1,i),14,1)
+             ibit13 = IBITS(wall_flags_0(k,j-1,i),13,1)
+             ibit12 = IBITS(wall_flags_0(k,j-1,i),12,1)
+
+             v_comp      = v(k,j,i) + v(k,j,i-1) - gv
+             flux_s_u(k,tn) = v_comp * (                                      &
+                            ( 37.0_wp * ibit14 * adv_mom_5                    &
+                         +     7.0_wp * ibit13 * adv_mom_3                    &
+                         +              ibit12 * adv_mom_1                    &
+                            ) *                                               &
+                                        ( u(k,j,i)   + u(k,j-1,i) )           &
+                     -      (  8.0_wp * ibit14 * adv_mom_5                    &
+                         +              ibit13 * adv_mom_3                    &
+                            ) *                                               &
+                                        ( u(k,j+1,i) + u(k,j-2,i) )           &
+                     +      (           ibit14 * adv_mom_5                    &
+                            ) *                                               &
+                                        ( u(k,j+2,i) + u(k,j-3,i) )           &
+                                       )
+
+             diss_s_u(k,tn) = - ABS ( v_comp ) * (                            &
+                            ( 10.0_wp * ibit14 * adv_mom_5                    &
+                         +     3.0_wp * ibit13 * adv_mom_3                    &
+                         +              ibit12 * adv_mom_1                    &
+                            ) *                                               &
+                                        ( u(k,j,i)   - u(k,j-1,i) )           &
+                     -      (  5.0_wp * ibit14 * adv_mom_5                    &
+                         +              ibit13 * adv_mom_3                    &
+                            ) *                                               &
+                                        ( u(k,j+1,i) - u(k,j-2,i) )           &
+                     +      (           ibit14 * adv_mom_5                    &
+                            ) *                                               &
+                                        ( u(k,j+2,i) - u(k,j-3,i) )           &
+                                                 )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             v_comp         = v(k,j,i) + v(k,j,i-1) - gv
+             flux_s_u(k,tn) = v_comp * (                                      &
+                           37.0_wp * ( u(k,j,i) + u(k,j-1,i)   )              &
+                         -  8.0_wp * ( u(k,j+1,i) + u(k,j-2,i) )              &
+                         +           ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5
+             diss_s_u(k,tn) = - ABS(v_comp) * (                               &
+                           10.0_wp * ( u(k,j,i) - u(k,j-1,i)   )              &
+                         -  5.0_wp * ( u(k,j+1,i) - u(k,j-2,i) )              &
+                         +           ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_5
+
+          ENDDO
+          
+       ENDIF
+!
+!--    Compute leftside fluxes for the respective boundary of PE
+       IF ( i == i_omp )  THEN
+       
+          DO  k = nzb+1, nzb_max
+
+             ibit11 = IBITS(wall_flags_0(k,j,i-1),11,1)
+             ibit10 = IBITS(wall_flags_0(k,j,i-1),10,1)
+             ibit9  = IBITS(wall_flags_0(k,j,i-1),9,1)
+
+             u_comp_l         = u(k,j,i) + u(k,j,i-1) - gu
+             flux_l_u(k,j,tn) = u_comp_l * (                                  &
+                              ( 37.0_wp * ibit11 * adv_mom_5                  &
+                           +     7.0_wp * ibit10 * adv_mom_3                  &
+                           +              ibit9  * adv_mom_1                  &
+                              ) *                                             &
+                                          ( u(k,j,i)   + u(k,j,i-1) )         &
+                       -      (  8.0_wp * ibit11 * adv_mom_5                  &
+                           +              ibit10 * adv_mom_3                  &
+                              ) *                                             &
+                                          ( u(k,j,i+1) + u(k,j,i-2) )         &
+                       +      (           ibit11 * adv_mom_5                  &
+                              ) *                                             &
+                                          ( u(k,j,i+2) + u(k,j,i-3) )         &
+                                           )
+
+              diss_l_u(k,j,tn) = - ABS( u_comp_l ) * (                        &
+                              ( 10.0_wp * ibit11 * adv_mom_5                  &
+                           +     3.0_wp * ibit10 * adv_mom_3                  &
+                           +              ibit9  * adv_mom_1                  &
+                              ) *                                             &
+                                        ( u(k,j,i)   - u(k,j,i-1) )           &
+                       -      (  5.0_wp * ibit11 * adv_mom_5                  &
+                           +              ibit10 * adv_mom_3                  &
+                              ) *                                             &
+                                        ( u(k,j,i+1) - u(k,j,i-2) )           &
+                       +      (           ibit11 * adv_mom_5                  &
+                              ) *                                             &
+                                        ( u(k,j,i+2) - u(k,j,i-3) )           &
+                                                     )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             u_comp_l         = u(k,j,i) + u(k,j,i-1) - gu
+             flux_l_u(k,j,tn) = u_comp_l * (                                   &
+                             37.0_wp * ( u(k,j,i) + u(k,j,i-1)   )             &
+                           -  8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) )             &
+                           +           ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_5
+             diss_l_u(k,j,tn) = - ABS(u_comp_l) * (                            &
+                             10.0_wp * ( u(k,j,i) - u(k,j,i-1)   )             &
+                           -  5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) )             &
+                           +           ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_5
+
+          ENDDO
+          
+       ENDIF
+
+       flux_t(0) = 0.0_wp
+       diss_t(0) = 0.0_wp
+       flux_d    = 0.0_wp
+       diss_d    = 0.0_wp
+!
+!--    Now compute the fluxes tendency terms for the horizontal and
+!--    vertical parts.
+       DO  k = nzb+1, nzb_max
+
+          ibit11 = IBITS(wall_flags_0(k,j,i),11,1)
+          ibit10 = IBITS(wall_flags_0(k,j,i),10,1)
+          ibit9  = IBITS(wall_flags_0(k,j,i),9,1)
+
+          u_comp(k) = u(k,j,i+1) + u(k,j,i)
+          flux_r(k) = ( u_comp(k) - gu ) * (                                  &
+                     ( 37.0_wp * ibit11 * adv_mom_5                           &
+                  +     7.0_wp * ibit10 * adv_mom_3                           &
+                  +              ibit9  * adv_mom_1                           &
+                     ) *                                                      &
+                                    ( u(k,j,i+1) + u(k,j,i)   )               &
+              -      (  8.0_wp * ibit11 * adv_mom_5                           &
+                  +              ibit10 * adv_mom_3                           & 
+                     ) *                                                      &
+                                    ( u(k,j,i+2) + u(k,j,i-1) )               &
+              +      (           ibit11 * adv_mom_5                           &
+                     ) *                                                      &
+                                    ( u(k,j,i+3) + u(k,j,i-2) )               &
+                                           )
+
+          diss_r(k) = - ABS( u_comp(k) - gu ) * (                             &
+                     ( 10.0_wp * ibit11 * adv_mom_5                           &
+                  +     3.0_wp * ibit10 * adv_mom_3                           &
+                  +              ibit9  * adv_mom_1                           &
+                     ) *                                                      &
+                                    ( u(k,j,i+1) - u(k,j,i)   )               &
+              -      (  5.0_wp * ibit11 * adv_mom_5                           &
+                  +              ibit10 * adv_mom_3                           &
+                     ) *                                                      &
+                                    ( u(k,j,i+2) - u(k,j,i-1) )               &
+              +      (           ibit11 * adv_mom_5                           &
+                     ) *                                                      &
+                                    ( u(k,j,i+3) - u(k,j,i-2) )               &
+                                                )
+
+          ibit14 = IBITS(wall_flags_0(k,j,i),14,1)
+          ibit13 = IBITS(wall_flags_0(k,j,i),13,1)
+          ibit12 = IBITS(wall_flags_0(k,j,i),12,1)
+
+          v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
+          flux_n(k) = v_comp * (                                              &
+                     ( 37.0_wp * ibit14 * adv_mom_5                           &
+                  +     7.0_wp * ibit13 * adv_mom_3                           &
+                  +              ibit12 * adv_mom_1                           &
+                     ) *                                                      &
+                                    ( u(k,j+1,i) + u(k,j,i)   )               &
+              -      (  8.0_wp * ibit14 * adv_mom_5                           &
+                  +              ibit13 * adv_mom_3                           &
+                     ) *                                                      &
+                                    ( u(k,j+2,i) + u(k,j-1,i) )               &
+              +      (           ibit14 * adv_mom_5                           &
+                     ) *                                                      &
+                                    ( u(k,j+3,i) + u(k,j-2,i) )               &
+                               )
+
+          diss_n(k) = - ABS ( v_comp ) * (                                    &
+                     ( 10.0_wp * ibit14 * adv_mom_5                           &
+                  +     3.0_wp * ibit13 * adv_mom_3                           &
+                  +              ibit12 * adv_mom_1                           &
+                     ) *                                                      &
+                                    ( u(k,j+1,i) - u(k,j,i)   )               &
+              -      (  5.0_wp * ibit14 * adv_mom_5                           &
+                  +              ibit13 * adv_mom_3                           &
+                     ) *                                                      &
+                                    ( u(k,j+2,i) - u(k,j-1,i) )               &
+              +      (           ibit14 * adv_mom_5                           &
+                     ) *                                                      &
+                                    ( u(k,j+3,i) - u(k,j-2,i) )               &
+                                         )
+!
+!--       k index has to be modified near bottom and top, else array
+!--       subscripts will be exceeded.
+          ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
+          ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
+          ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
+
+          k_ppp = k + 3 * ibit17
+          k_pp  = k + 2 * ( 1 - ibit15 )
+          k_mm  = k - 2 * ibit17
+
+          w_comp    = w(k,j,i) + w(k,j,i-1)
+          flux_t(k) = w_comp  * (                                             &
+                     ( 37.0_wp * ibit17 * adv_mom_5                           &
+                  +     7.0_wp * ibit16 * adv_mom_3                           &
+                  +              ibit15 * adv_mom_1                           &
+                     ) *                                                      &
+                                ( u(k+1,j,i)  + u(k,j,i)     )                &
+              -      (  8.0_wp * ibit17 * adv_mom_5                           &
+                  +              ibit16 * adv_mom_3                           &
+                     ) *                                                      &
+                                ( u(k_pp,j,i) + u(k-1,j,i)   )                &
+              +      (           ibit17 * adv_mom_5                           &
+                     ) *                                                      &
+                                ( u(k_ppp,j,i) + u(k_mm,j,i) )                &
+                                 )
+
+          diss_t(k) = - ABS( w_comp ) * (                                     &
+                     ( 10.0_wp * ibit17 * adv_mom_5                           &
+                  +     3.0_wp * ibit16 * adv_mom_3                           &
+                  +              ibit15 * adv_mom_1                           &
+                     ) *                                                      &
+                                ( u(k+1,j,i)   - u(k,j,i)    )                &
+              -      (  5.0_wp * ibit17 * adv_mom_5                           &
+                  +              ibit16 * adv_mom_3                           &
+                     ) *                                                      &
+                                ( u(k_pp,j,i)  - u(k-1,j,i)  )                &
+              +      (           ibit17 * adv_mom_5                           &
+                     ) *                                                      &
+                                ( u(k_ppp,j,i) - u(k_mm,j,i) )                &
+                                         )
+!
+!--       Calculate the divergence of the velocity field. A respective
+!--       correction is needed to overcome numerical instabilities introduced
+!--       by a not sufficient reduction of divergences near topography. 
+          div = ( ( u_comp(k)       * ( ibit9 + ibit10 + ibit11 )             &
+                - ( u(k,j,i)   + u(k,j,i-1)   )                               &
+                                    * ( IBITS(wall_flags_0(k,j,i-1),9,1)      &
+                                      + IBITS(wall_flags_0(k,j,i-1),10,1)     &
+                                      + IBITS(wall_flags_0(k,j,i-1),11,1)     &
+                                      )                                       &   
+                  ) * ddx                                                     &
+               +  ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 )            &
+                  - ( v(k,j,i)   + v(k,j,i-1 )  )                             &
+                                    * ( IBITS(wall_flags_0(k,j-1,i),12,1)     &
+                                      + IBITS(wall_flags_0(k,j-1,i),13,1)     &
+                                      + IBITS(wall_flags_0(k,j-1,i),14,1)     &
+                                      )                                       &
+                  ) * ddy                                                     &
+               +  ( w_comp          * ( ibit15 + ibit16 + ibit17 )            &
+                - ( w(k-1,j,i) + w(k-1,j,i-1) )                               &
+                                    * ( IBITS(wall_flags_0(k-1,j,i),15,1)     &
+                                      + IBITS(wall_flags_0(k-1,j,i),16,1)     &
+                                      + IBITS(wall_flags_0(k-1,j,i),17,1)     &
+                                      )                                       &  
+                  ) * ddzw(k)   &
+                ) * 0.5_wp
+
+
+          tend(k,j,i) = tend(k,j,i) - (                                       &
+                            ( flux_r(k) + diss_r(k)                           &
+                          -   flux_l_u(k,j,tn) - diss_l_u(k,j,tn) ) * ddx     &
+                          + ( flux_n(k) + diss_n(k)                           &
+                          -   flux_s_u(k,tn) - diss_s_u(k,tn)     ) * ddy     &
+                          + ( flux_t(k) + diss_t(k)                           &
+                          -   flux_d    - diss_d                  ) * ddzw(k) &
+                                       ) + div * u(k,j,i)
+
+           flux_l_u(k,j,tn) = flux_r(k)
+           diss_l_u(k,j,tn) = diss_r(k)
+           flux_s_u(k,tn)   = flux_n(k)
+           diss_s_u(k,tn)   = diss_n(k)
+           flux_d           = flux_t(k)
+           diss_d           = diss_t(k)
+!
+!--        Statistical Evaluation of u'u'. The factor has to be applied for
+!--        right evaluation when gallilei_trans = .T. .
+           sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                          &
+                              + ( flux_r(k) *                                 &
+                                ( u_comp(k) - 2.0_wp * hom(k,1,1,0) )         &
+                              / ( u_comp(k) - gu + 1.0E-20_wp   )             &
+                              +   diss_r(k) *                                 &
+                                  ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0) )    &
+                              / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) )      &
+                              *   weight_substep(intermediate_timestep_count)
+!
+!--        Statistical Evaluation of w'u'.
+           sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                        &
+                              + ( flux_t(k) + diss_t(k) )                     &
+                              *   weight_substep(intermediate_timestep_count)
+       ENDDO
+
+       DO  k = nzb_max+1, nzt
+
+          u_comp(k) = u(k,j,i+1) + u(k,j,i)
+          flux_r(k) = ( u_comp(k) - gu ) * (                                  &
+                         37.0_wp * ( u(k,j,i+1) + u(k,j,i)   )                &
+                       -  8.0_wp * ( u(k,j,i+2) + u(k,j,i-1) )                &
+                       +           ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_5
+             diss_r(k) = - ABS( u_comp(k) - gu ) * (                          &
+                         10.0_wp * ( u(k,j,i+1) - u(k,j,i)   )                &
+                       -  5.0_wp * ( u(k,j,i+2) - u(k,j,i-1) )                &
+                       +           ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_5
+
+             v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
+             flux_n(k) = v_comp * (                                           &
+                         37.0_wp * ( u(k,j+1,i) + u(k,j,i)   )                &
+                       -  8.0_wp * ( u(k,j+2,i) + u(k,j-1,i) )                &
+                       +           ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_5
+             diss_n(k) = - ABS( v_comp ) * (                                  &
+                         10.0_wp * ( u(k,j+1,i) - u(k,j,i)   )                &
+                       -  5.0_wp * ( u(k,j+2,i) - u(k,j-1,i) )                &
+                       +           ( u(k,j+3,i) - u(k,j-2,i) ) ) * adv_mom_5
+!
+!--       k index has to be modified near bottom and top, else array
+!--       subscripts will be exceeded.
+          ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
+          ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
+          ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
+
+          k_ppp = k + 3 * ibit17
+          k_pp  = k + 2 * ( 1 - ibit15 )
+          k_mm  = k - 2 * ibit17
+
+          w_comp    = w(k,j,i) + w(k,j,i-1)
+          flux_t(k) = w_comp  * (                                             &
+                     ( 37.0_wp * ibit17 * adv_mom_5                           &
+                  +     7.0_wp * ibit16 * adv_mom_3                           &
+                  +              ibit15 * adv_mom_1                           &
+                     ) *                                                      &
+                                ( u(k+1,j,i)  + u(k,j,i)     )                &
+              -      (  8.0_wp * ibit17 * adv_mom_5                           &
+                  +              ibit16 * adv_mom_3                           &
+                     ) *                                                      &
+                                ( u(k_pp,j,i) + u(k-1,j,i)   )                &
+              +      (           ibit17 * adv_mom_5                           &
+                     ) *                                                      &
+                                ( u(k_ppp,j,i) + u(k_mm,j,i) )                &
+                                 )
+
+          diss_t(k) = - ABS( w_comp ) * (                                     &
+                     ( 10.0_wp * ibit17 * adv_mom_5                           &
+                  +     3.0_wp * ibit16 * adv_mom_3                           &
+                  +              ibit15 * adv_mom_1                           &
+                     ) *                                                      &
+                                ( u(k+1,j,i)   - u(k,j,i)    )                &
+              -      (  5.0_wp * ibit17 * adv_mom_5                           &
+                  +              ibit16 * adv_mom_3                           &
+                     ) *                                                      &
+                                ( u(k_pp,j,i)  - u(k-1,j,i)  )                &
+              +      (           ibit17 * adv_mom_5                           &
+                     ) *                                                      &
+                                ( u(k_ppp,j,i) - u(k_mm,j,i) )                &
+                                         )
+!
+!--       Calculate the divergence of the velocity field. A respective
+!--       correction is needed to overcome numerical instabilities introduced
+!--       by a not sufficient reduction of divergences near topography.
+          div = ( ( u_comp(k)   - ( u(k,j,i)   + u(k,j,i-1)   ) ) * ddx       &
+               +  ( v_comp + gv - ( v(k,j,i)   + v(k,j,i-1 )  ) ) * ddy       &
+               +  ( w_comp      - ( w(k-1,j,i) + w(k-1,j,i-1) ) ) * ddzw(k)   &
+                ) * 0.5_wp
+
+          tend(k,j,i) = tend(k,j,i) - (                                       &
+                            ( flux_r(k) + diss_r(k)                           &
+                          -   flux_l_u(k,j,tn) - diss_l_u(k,j,tn) ) * ddx     &
+                          + ( flux_n(k) + diss_n(k)                           &
+                          -   flux_s_u(k,tn) - diss_s_u(k,tn)     ) * ddy     &
+                          + ( flux_t(k) + diss_t(k)                           &
+                          -   flux_d    - diss_d                  ) * ddzw(k) &
+                                       ) + div * u(k,j,i)
+
+           flux_l_u(k,j,tn) = flux_r(k)
+           diss_l_u(k,j,tn) = diss_r(k)
+           flux_s_u(k,tn)   = flux_n(k)
+           diss_s_u(k,tn)   = diss_n(k)
+           flux_d           = flux_t(k)
+           diss_d           = diss_t(k)
+!
+!--        Statistical Evaluation of u'u'. The factor has to be applied for
+!--        right evaluation when gallilei_trans = .T. .
+           sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                          &
+                              + ( flux_r(k) *                                 &
+                                ( u_comp(k) - 2.0_wp * hom(k,1,1,0)      )    &
+                              / ( u_comp(k) - gu + 1.0E-20_wp          )      &
+                              +   diss_r(k) *                                 &
+                                  ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0) )    &
+                              / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) )      &
+                              *   weight_substep(intermediate_timestep_count)
+!
+!--        Statistical Evaluation of w'u'.
+           sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                        &
+                              + ( flux_t(k) + diss_t(k) )                     &
+                              *   weight_substep(intermediate_timestep_count)
+       ENDDO
+
+       sums_us2_ws_l(nzb,tn) = sums_us2_ws_l(nzb+1,tn)
+
+
+
+    END SUBROUTINE advec_u_ws_ij
+
+
+
+!-----------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Advection of v-component - Call for grid point i,j
+!-----------------------------------------------------------------------------!
+   SUBROUTINE advec_v_ws_ij( i, j, i_omp, tn )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, diss_l_v, diss_s_v, flux_l_v, flux_s_v, tend, u, v, w
+
+       USE constants,                                                          &
+           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
+
+       USE control_parameters,                                                 &
+           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, wall_flags_0
+
+       USE kinds
+
+       USE statistics,                                                         &
+           ONLY:  hom, sums_vs2_ws_l, sums_wsvs_ws_l, weight_substep
+
+       IMPLICIT NONE
+
+       INTEGER(iwp)  ::  i      !<
+       INTEGER(iwp)  ::  ibit18 !<
+       INTEGER(iwp)  ::  ibit19 !<
+       INTEGER(iwp)  ::  ibit20 !<
+       INTEGER(iwp)  ::  ibit21 !<
+       INTEGER(iwp)  ::  ibit22 !<
+       INTEGER(iwp)  ::  ibit23 !<
+       INTEGER(iwp)  ::  ibit24 !<
+       INTEGER(iwp)  ::  ibit25 !<
+       INTEGER(iwp)  ::  ibit26 !<
+       INTEGER(iwp)  ::  i_omp  !<
+       INTEGER(iwp)  ::  j      !<
+       INTEGER(iwp)  ::  k      !<
+       INTEGER(iwp)  ::  k_mm   !<
+       INTEGER(iwp)  ::  k_pp   !<
+       INTEGER(iwp)  ::  k_ppp  !<
+       INTEGER(iwp)  ::  tn     !<
+       
+       REAL(wp)     ::  diss_d   !<
+       REAL(wp)     ::  div      !<
+       REAL(wp)     ::  flux_d   !<
+       REAL(wp)     ::  gu       !<
+       REAL(wp)     ::  gv       !<
+       REAL(wp)     ::  u_comp   !<
+       REAL(wp)     ::  v_comp_l !<
+       REAL(wp)     ::  w_comp   !<
+       
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_n !<
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_r !<
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_t !<
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_n !<
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_r !<
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_t !<
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  v_comp !<
+
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+
+!       
+!--    Compute leftside fluxes for the respective boundary.
+       IF ( i == i_omp )  THEN
+
+          DO  k = nzb+1, nzb_max
+
+             ibit20 = IBITS(wall_flags_0(k,j,i-1),20,1)
+             ibit19 = IBITS(wall_flags_0(k,j,i-1),19,1)
+             ibit18 = IBITS(wall_flags_0(k,j,i-1),18,1)
+
+             u_comp           = u(k,j-1,i) + u(k,j,i) - gu
+             flux_l_v(k,j,tn) = u_comp * (                                    &
+                              ( 37.0_wp * ibit20 * adv_mom_5                  &
+                           +     7.0_wp * ibit19 * adv_mom_3                  &
+                           +              ibit18 * adv_mom_1                  &
+                              ) *                                             &
+                                        ( v(k,j,i)   + v(k,j,i-1) )           &
+                       -      (  8.0_wp * ibit20 * adv_mom_5                  &
+                           +              ibit19 * adv_mom_3                  &
+                              ) *                                             &
+                                        ( v(k,j,i+1) + v(k,j,i-2) )           &
+                       +      (           ibit20 * adv_mom_5                  &
+                              ) *                                             &
+                                        ( v(k,j,i+2) + v(k,j,i-3) )           &
+                                         )
+
+              diss_l_v(k,j,tn) = - ABS( u_comp ) * (                          &
+                              ( 10.0_wp * ibit20 * adv_mom_5                  &
+                           +     3.0_wp * ibit19 * adv_mom_3                  &
+                           +              ibit18 * adv_mom_1                  &
+                              ) *                                             &
+                                        ( v(k,j,i)   - v(k,j,i-1) )           &
+                       -      (  5.0_wp * ibit20 * adv_mom_5                  &
+                           +              ibit19 * adv_mom_3                  &
+                              ) *                                             &
+                                        ( v(k,j,i+1) - v(k,j,i-2) )           &
+                       +      (           ibit20 * adv_mom_5                  &
+                              ) *                                             &
+                                        ( v(k,j,i+2) - v(k,j,i-3) )           &
+                                                   )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             u_comp           = u(k,j-1,i) + u(k,j,i) - gu
+             flux_l_v(k,j,tn) = u_comp * (                                    &
+                             37.0_wp * ( v(k,j,i) + v(k,j,i-1)   )            &
+                           -  8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) )            &
+                           +           ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5
+             diss_l_v(k,j,tn) = - ABS( u_comp ) * (                           &
+                             10.0_wp * ( v(k,j,i) - v(k,j,i-1)   )            &
+                           -  5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) )            &
+                           +           ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5
+
+          ENDDO
+          
+       ENDIF
+!
+!--    Compute southside fluxes for the respective boundary.
+       IF ( j == nysv )  THEN
+       
+          DO  k = nzb+1, nzb_max
+
+             ibit23 = IBITS(wall_flags_0(k,j-1,i),23,1)
+             ibit22 = IBITS(wall_flags_0(k,j-1,i),22,1)
+             ibit21 = IBITS(wall_flags_0(k,j-1,i),21,1)
+
+             v_comp_l       = v(k,j,i) + v(k,j-1,i) - gv
+             flux_s_v(k,tn) = v_comp_l * (                                    &
+                            ( 37.0_wp * ibit23 * adv_mom_5                    &
+                         +     7.0_wp * ibit22 * adv_mom_3                    &
+                         +              ibit21 * adv_mom_1                    &
+                            ) *                                               &
+                                        ( v(k,j,i)   + v(k,j-1,i) )           &
+                     -      (  8.0_wp * ibit23 * adv_mom_5                    &
+                         +              ibit22 * adv_mom_3                    &
+                            ) *                                               &
+                                        ( v(k,j+1,i) + v(k,j-2,i) )           &
+                     +      (           ibit23 * adv_mom_5                    &
+                            ) *                                               &
+                                        ( v(k,j+2,i) + v(k,j-3,i) )           &
+                                         )
+
+             diss_s_v(k,tn) = - ABS( v_comp_l ) * (                           &
+                            ( 10.0_wp * ibit23 * adv_mom_5                    &
+                         +     3.0_wp * ibit22 * adv_mom_3                    &
+                         +              ibit21 * adv_mom_1                    &
+                            ) *                                               &
+                                        ( v(k,j,i)   - v(k,j-1,i) )           &
+                     -      (  5.0_wp * ibit23 * adv_mom_5                    &
+                         +              ibit22 * adv_mom_3                    &
+                            ) *                                               &
+                                        ( v(k,j+1,i) - v(k,j-2,i) )           &
+                     +      (           ibit23 * adv_mom_5                    &
+                            ) *                                               &
+                                        ( v(k,j+2,i) - v(k,j-3,i) )           &
+                                                  )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             v_comp_l       = v(k,j,i) + v(k,j-1,i) - gv
+             flux_s_v(k,tn) = v_comp_l * (                                    &
+                           37.0_wp * ( v(k,j,i) + v(k,j-1,i)   )              &
+                         -  8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) )              &
+                         +           ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5
+             diss_s_v(k,tn) = - ABS( v_comp_l ) * (                           &
+                           10.0_wp * ( v(k,j,i) - v(k,j-1,i)   )              &
+                         -  5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) )              &
+                         +           ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5
+
+          ENDDO
+          
+       ENDIF
+
+       flux_t(0) = 0.0_wp
+       diss_t(0) = 0.0_wp
+       flux_d    = 0.0_wp
+       diss_d    = 0.0_wp
+!
+!--    Now compute the fluxes and tendency terms for the horizontal and
+!--    verical parts.
+       DO  k = nzb+1, nzb_max
+
+          ibit20 = IBITS(wall_flags_0(k,j,i),20,1)
+          ibit19 = IBITS(wall_flags_0(k,j,i),19,1)
+          ibit18 = IBITS(wall_flags_0(k,j,i),18,1)
+ 
+          u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
+          flux_r(k) = u_comp * (                                              &
+                     ( 37.0_wp * ibit20 * adv_mom_5                           &
+                  +     7.0_wp * ibit19 * adv_mom_3                           &
+                  +              ibit18 * adv_mom_1                           &
+                     ) *                                                      &
+                                    ( v(k,j,i+1) + v(k,j,i)   )               &
+              -      (  8.0_wp * ibit20 * adv_mom_5                           &
+                  +              ibit19 * adv_mom_3                           &
+                     ) *                                                      &
+                                    ( v(k,j,i+2) + v(k,j,i-1) )               &
+              +      (           ibit20 * adv_mom_5                           &
+                     ) *                                                      &
+                                    ( v(k,j,i+3) + v(k,j,i-2) )               &
+                               )
+
+          diss_r(k) = - ABS( u_comp ) * (                                     &
+                     ( 10.0_wp * ibit20 * adv_mom_5                           &
+                  +     3.0_wp * ibit19 * adv_mom_3                           &
+                  +              ibit18 * adv_mom_1                           &
+                     ) *                                                      &
+                                    ( v(k,j,i+1) - v(k,j,i)  )                &
+              -      (  5.0_wp * ibit20 * adv_mom_5                           &
+                  +              ibit19 * adv_mom_3                           &
+                     ) *                                                      &
+                                    ( v(k,j,i+2) - v(k,j,i-1) )               &
+              +      (           ibit20 * adv_mom_5                           &
+                     ) *                                                      &
+                                    ( v(k,j,i+3) - v(k,j,i-2) )               &
+                                        )
+
+          ibit23 = IBITS(wall_flags_0(k,j,i),23,1)
+          ibit22 = IBITS(wall_flags_0(k,j,i),22,1)
+          ibit21 = IBITS(wall_flags_0(k,j,i),21,1)
+
+
+          v_comp(k) = v(k,j+1,i) + v(k,j,i)
+          flux_n(k) = ( v_comp(k) - gv ) * (                                  &
+                     ( 37.0_wp * ibit23 * adv_mom_5                           &
+                  +     7.0_wp * ibit22 * adv_mom_3                           &
+                  +              ibit21 * adv_mom_1                           &
+                     ) *                                                      &
+                                    ( v(k,j+1,i) + v(k,j,i)   )               &
+              -      (  8.0_wp * ibit23 * adv_mom_5                           &
+                  +              ibit22 * adv_mom_3                           &
+                     ) *                                                      &
+                                    ( v(k,j+2,i) + v(k,j-1,i) )               &
+              +      (           ibit23 * adv_mom_5                           &
+                     ) *                                                      &
+                                    ( v(k,j+3,i) + v(k,j-2,i) )               &
+                                           )
+
+          diss_n(k) = - ABS( v_comp(k) - gv ) * (                             &
+                     ( 10.0_wp * ibit23 * adv_mom_5                           &
+                  +     3.0_wp * ibit22 * adv_mom_3                           &
+                  +              ibit21 * adv_mom_1                           &
+                     ) *                                                      &
+                                    ( v(k,j+1,i) - v(k,j,i)   )               &
+              -      (  5.0_wp * ibit23 * adv_mom_5                           &
+                  +              ibit22 * adv_mom_3                           &
+                     ) *                                                      &
+                                    ( v(k,j+2,i) - v(k,j-1,i) )               &
+              +      (           ibit23 * adv_mom_5                           &
+                     ) *                                                      &
+                                    ( v(k,j+3,i) - v(k,j-2,i) )               &
+                                                )
+!
+!--       k index has to be modified near bottom and top, else array
+!--       subscripts will be exceeded.
+          ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
+          ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
+          ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
+
+          k_ppp = k + 3 * ibit26
+          k_pp  = k + 2 * ( 1 - ibit24  )
+          k_mm  = k - 2 * ibit26
+
+          w_comp    = w(k,j-1,i) + w(k,j,i)
+          flux_t(k) = w_comp  * (                                             &
+                     ( 37.0_wp * ibit26 * adv_mom_5                           &
+                  +     7.0_wp * ibit25 * adv_mom_3                           &
+                  +              ibit24 * adv_mom_1                           &
+                     ) *                                                      &
+                                ( v(k+1,j,i)   + v(k,j,i)    )                &
+              -      (  8.0_wp * ibit26 * adv_mom_5                           &
+                  +              ibit25 * adv_mom_3                           &
+                     ) *                                                      &
+                                ( v(k_pp,j,i)  + v(k-1,j,i)  )                &
+              +      (           ibit26 * adv_mom_5                           &
+                     ) *                                                      &
+                                ( v(k_ppp,j,i) + v(k_mm,j,i) )                &
+                                 )
+
+          diss_t(k) = - ABS( w_comp ) * (                                     &
+                     ( 10.0_wp * ibit26 * adv_mom_5                           &
+                  +     3.0_wp * ibit25 * adv_mom_3                           &
+                  +              ibit24 * adv_mom_1                           &
+                     ) *                                                      &
+                                ( v(k+1,j,i)   - v(k,j,i)    )                &
+              -      (  5.0_wp * ibit26 * adv_mom_5                           &
+                  +              ibit25 * adv_mom_3                           &
+                     ) *                                                      &
+                                ( v(k_pp,j,i)  - v(k-1,j,i)  )                &
+              +      (           ibit26 * adv_mom_5                           &
+                     ) *                                                      &
+                                ( v(k_ppp,j,i) - v(k_mm,j,i) )                &
+                                         )
+!
+!--       Calculate the divergence of the velocity field. A respective
+!--       correction is needed to overcome numerical instabilities introduced
+!--       by a not sufficient reduction of divergences near topography. 
+          div = ( ( ( u_comp     + gu )                                       &
+                                       * ( ibit18 + ibit19 + ibit20 )         &
+                  - ( u(k,j-1,i) + u(k,j,i) )                                 &
+                                       * ( IBITS(wall_flags_0(k,j,i-1),18,1)  &
+                                         + IBITS(wall_flags_0(k,j,i-1),19,1)  &
+                                         + IBITS(wall_flags_0(k,j,i-1),20,1)  &
+                                         )                                    &   
+                  ) * ddx                                                     &
+               +  ( v_comp(k)                                                 &
+                                       * ( ibit21 + ibit22 + ibit23 )         &
+                - ( v(k,j,i)     + v(k,j-1,i) )                               &
+                                       * ( IBITS(wall_flags_0(k,j-1,i),21,1)  &
+                                         + IBITS(wall_flags_0(k,j-1,i),22,1)  &
+                                         + IBITS(wall_flags_0(k,j-1,i),23,1)  &
+                                         )                                    &   
+                  ) * ddy                                                     &
+               +  ( w_comp                                                    &
+                                       * ( ibit24 + ibit25 + ibit26 )         &
+                - ( w(k-1,j-1,i) + w(k-1,j,i) )                               &
+                                       * ( IBITS(wall_flags_0(k-1,j,i),24,1)  &
+                                         + IBITS(wall_flags_0(k-1,j,i),25,1)  &
+                                         + IBITS(wall_flags_0(k-1,j,i),26,1)  &
+                                         )                                    &
+                   ) * ddzw(k)   &
+                ) * 0.5_wp
+
+
+          tend(k,j,i) = tend(k,j,i) - (                                       &
+                         ( flux_r(k) + diss_r(k)                              &
+                       -   flux_l_v(k,j,tn) - diss_l_v(k,j,tn)   ) * ddx      &
+                       + ( flux_n(k) + diss_n(k)                              &
+                       -   flux_s_v(k,tn) - diss_s_v(k,tn)       ) * ddy      &
+                       + ( flux_t(k) + diss_t(k)                              &
+                       -   flux_d    - diss_d                    ) * ddzw(k)  &
+                                      ) + v(k,j,i) * div
+
+           flux_l_v(k,j,tn) = flux_r(k)
+           diss_l_v(k,j,tn) = diss_r(k)
+           flux_s_v(k,tn)   = flux_n(k)
+           diss_s_v(k,tn)   = diss_n(k)
+           flux_d           = flux_t(k)
+           diss_d           = diss_t(k)
+
+!
+!--        Statistical Evaluation of v'v'. The factor has to be applied for
+!--        right evaluation when gallilei_trans = .T. .
+           sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                          &
+             + ( flux_n(k)                                                    &
+             * ( v_comp(k) - 2.0_wp * hom(k,1,2,0)      )                     &
+             / ( v_comp(k) - gv + 1.0E-20_wp       )                          &
+             +   diss_n(k)                                                    &
+             *   ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0) )                     &
+             / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) )                        &
+             *   weight_substep(intermediate_timestep_count)
+!
+!--        Statistical Evaluation of w'v'.
+           sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                        &
+                              + ( flux_t(k) + diss_t(k) )                     &
+                              *   weight_substep(intermediate_timestep_count)
+
+       ENDDO
+
+       DO  k = nzb_max+1, nzt
+
+          u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
+          flux_r(k) = u_comp * (                                              &
+                      37.0_wp * ( v(k,j,i+1) + v(k,j,i)   )                   &
+                    -  8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) )                   &
+                    +           ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_5
+
+          diss_r(k) = - ABS( u_comp ) * (                                     &
+                      10.0_wp * ( v(k,j,i+1) - v(k,j,i) )                     &
+                    -  5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) )                   &
+                    +           ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_5
+
+
+          v_comp(k) = v(k,j+1,i) + v(k,j,i)
+          flux_n(k) = ( v_comp(k) - gv ) * (                                  &
+                      37.0_wp * ( v(k,j+1,i) + v(k,j,i)   )                   &
+                    -  8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) )                   &
+                      +         ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_5
+
+          diss_n(k) = - ABS( v_comp(k) - gv ) * (                             &
+                      10.0_wp * ( v(k,j+1,i) - v(k,j,i)   )                   &
+                    -  5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) )                   &
+                    +           ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_5
+!
+!--       k index has to be modified near bottom and top, else array
+!--       subscripts will be exceeded.
+          ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
+          ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
+          ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
+
+          k_ppp = k + 3 * ibit26
+          k_pp  = k + 2 * ( 1 - ibit24  )
+          k_mm  = k - 2 * ibit26
+
+          w_comp    = w(k,j-1,i) + w(k,j,i)
+          flux_t(k) = w_comp  * (                                             &
+                     ( 37.0_wp * ibit26 * adv_mom_5                           &
+                  +     7.0_wp * ibit25 * adv_mom_3                           &
+                  +              ibit24 * adv_mom_1                           &
+                     ) *                                                      &
+                                ( v(k+1,j,i)   + v(k,j,i)    )                &
+              -      (  8.0_wp * ibit26 * adv_mom_5                           &
+                  +              ibit25 * adv_mom_3                           &
+                     ) *                                                      &
+                                ( v(k_pp,j,i)  + v(k-1,j,i)  )                &
+              +      (           ibit26 * adv_mom_5                           &
+                     ) *                                                      &
+                                ( v(k_ppp,j,i) + v(k_mm,j,i) )                &
+                                 )
+
+          diss_t(k) = - ABS( w_comp ) * (                                     &
+                     ( 10.0_wp * ibit26 * adv_mom_5                           &
+                  +     3.0_wp * ibit25 * adv_mom_3                           &
+                  +              ibit24 * adv_mom_1                           &
+                     ) *                                                      &
+                                ( v(k+1,j,i)   - v(k,j,i)    )                &
+              -      (  5.0_wp * ibit26 * adv_mom_5                           &
+                  +              ibit25 * adv_mom_3                           &
+                     ) *                                                      &
+                                ( v(k_pp,j,i)  - v(k-1,j,i)  )                &
+              +      (           ibit26 * adv_mom_5                           &
+                     ) *                                                      &
+                                ( v(k_ppp,j,i) - v(k_mm,j,i) )                &
+                                         )
+!
+!--       Calculate the divergence of the velocity field. A respective
+!--       correction is needed to overcome numerical instabilities introduced
+!--       by a not sufficient reduction of divergences near topography.
+          div = ( ( u_comp + gu - ( u(k,j-1,i)   + u(k,j,i)   ) ) * ddx       &
+               +  ( v_comp(k)   - ( v(k,j,i)     + v(k,j-1,i) ) ) * ddy       &
+               +  ( w_comp      - ( w(k-1,j-1,i) + w(k-1,j,i) ) ) * ddzw(k)   &
+                ) * 0.5_wp
+
+          tend(k,j,i) = tend(k,j,i) - (                                       &
+                         ( flux_r(k) + diss_r(k)                              &
+                       -   flux_l_v(k,j,tn) - diss_l_v(k,j,tn)   ) * ddx      &
+                       + ( flux_n(k) + diss_n(k)                              &
+                       -   flux_s_v(k,tn) - diss_s_v(k,tn)       ) * ddy      &
+                       + ( flux_t(k) + diss_t(k)                              &
+                       -   flux_d    - diss_d                    ) * ddzw(k)  &
+                                      ) + v(k,j,i) * div
+
+           flux_l_v(k,j,tn) = flux_r(k)
+           diss_l_v(k,j,tn) = diss_r(k)
+           flux_s_v(k,tn)   = flux_n(k)
+           diss_s_v(k,tn)   = diss_n(k)
+           flux_d           = flux_t(k)
+           diss_d           = diss_t(k)
+
+!
+!--        Statistical Evaluation of v'v'. The factor has to be applied for
+!--        right evaluation when gallilei_trans = .T. .
+           sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                          &
+             + ( flux_n(k)                                                    &
+             * ( v_comp(k) - 2.0_wp * hom(k,1,2,0)      )                     &
+             / ( v_comp(k) - gv + 1.0E-20_wp       )                          &
+             +   diss_n(k)                                                    &
+             *   ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0) )                     &
+             / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) )                        &
+             *   weight_substep(intermediate_timestep_count)
+!
+!--        Statistical Evaluation of w'v'.
+           sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                        &
+                              + ( flux_t(k) + diss_t(k) )                     &
+                              *   weight_substep(intermediate_timestep_count)
+
+       ENDDO
+       sums_vs2_ws_l(nzb,tn) = sums_vs2_ws_l(nzb+1,tn)
+
+
+    END SUBROUTINE advec_v_ws_ij
+
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Advection of w-component - Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_w_ws_ij( i, j, i_omp, tn )
+
+       USE arrays_3d,                                                         &
+           ONLY:  ddzu, diss_l_w, diss_s_w, flux_l_w, flux_s_w, tend, u, v, w
+
+       USE constants,                                                         &
+           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
+
+       USE control_parameters,                                                &
+           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
+
+       USE grid_variables,                                                    &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                           &
+           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0,        &
+                  wall_flags_00
+
+       USE kinds
+       
+       USE statistics,                                                        &
+           ONLY:  hom, sums_ws2_ws_l, weight_substep
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  ibit27 !<
+       INTEGER(iwp) ::  ibit28 !<
+       INTEGER(iwp) ::  ibit29 !<
+       INTEGER(iwp) ::  ibit30 !<
+       INTEGER(iwp) ::  ibit31 !<
+       INTEGER(iwp) ::  ibit32 !<
+       INTEGER(iwp) ::  ibit33 !<
+       INTEGER(iwp) ::  ibit34 !<
+       INTEGER(iwp) ::  ibit35 !<
+       INTEGER(iwp) ::  i_omp  !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  k      !<
+       INTEGER(iwp) ::  k_mm   !<
+       INTEGER(iwp) ::  k_pp   !<
+       INTEGER(iwp) ::  k_ppp  !<
+       INTEGER(iwp) ::  tn     !<
+       
+       REAL(wp)    ::  diss_d  !<
+       REAL(wp)    ::  div     !<
+       REAL(wp)    ::  flux_d  !<
+       REAL(wp)    ::  gu      !<
+       REAL(wp)    ::  gv      !<
+       REAL(wp)    ::  u_comp  !<
+       REAL(wp)    ::  v_comp  !<
+       REAL(wp)    ::  w_comp  !<
+       
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_n !<
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_r !<
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_t !<
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_n !<
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_r !<
+       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_t !<
+
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+
+!
+!--    Compute southside fluxes for the respective boundary.
+       IF ( j == nys )  THEN
+
+          DO  k = nzb+1, nzb_max
+             ibit32 = IBITS(wall_flags_00(k,j-1,i),0,1)
+             ibit31 = IBITS(wall_flags_0(k,j-1,i),31,1)
+             ibit30 = IBITS(wall_flags_0(k,j-1,i),30,1)
+
+             v_comp         = v(k+1,j,i) + v(k,j,i) - gv
+             flux_s_w(k,tn) = v_comp * (                                      &
+                            ( 37.0_wp * ibit32 * adv_mom_5                    &
+                         +     7.0_wp * ibit31 * adv_mom_3                    &
+                         +              ibit30 * adv_mom_1                    &
+                            ) *                                               &
+                                        ( w(k,j,i)   + w(k,j-1,i) )           &
+                     -      (  8.0_wp * ibit32 * adv_mom_5                    &
+                         +              ibit31 * adv_mom_3                    &
+                            ) *                                               &
+                                        ( w(k,j+1,i) + w(k,j-2,i) )           &
+                     +      (           ibit32 * adv_mom_5                    &
+                            ) *                                               &
+                                        ( w(k,j+2,i) + w(k,j-3,i) )           &
+                                       )
+
+             diss_s_w(k,tn) = - ABS( v_comp ) * (                             &
+                            ( 10.0_wp * ibit32 * adv_mom_5                    &
+                         +     3.0_wp * ibit31 * adv_mom_3                    &
+                         +              ibit30 * adv_mom_1                    &
+                            ) *                                               &
+                                        ( w(k,j,i)   - w(k,j-1,i) )           &
+                     -      (  5.0_wp * ibit32 * adv_mom_5                    &
+                         +              ibit31 * adv_mom_3                    &
+                            ) *                                               &
+                                        ( w(k,j+1,i) - w(k,j-2,i) )           &
+                     +      (           ibit32 * adv_mom_5                    &
+                            ) *                                               &
+                                        ( w(k,j+2,i) - w(k,j-3,i) )           &
+                                                )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             v_comp         = v(k+1,j,i) + v(k,j,i) - gv
+             flux_s_w(k,tn) = v_comp * (                                      &
+                           37.0_wp * ( w(k,j,i) + w(k,j-1,i)   )              &
+                         -  8.0_wp * ( w(k,j+1,i) +w(k,j-2,i)  )              &
+                         +           ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5
+             diss_s_w(k,tn) = - ABS( v_comp ) * (                             &
+                           10.0_wp * ( w(k,j,i) - w(k,j-1,i)   )              &
+                         -  5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) )              &
+                         +           ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5
+
+          ENDDO
+
+       ENDIF
+!
+!--    Compute leftside fluxes for the respective boundary.
+       IF ( i == i_omp ) THEN
+
+          DO  k = nzb+1, nzb_max
+
+             ibit29 = IBITS(wall_flags_0(k,j,i-1),29,1)
+             ibit28 = IBITS(wall_flags_0(k,j,i-1),28,1)
+             ibit27 = IBITS(wall_flags_0(k,j,i-1),27,1)
+
+             u_comp           = u(k+1,j,i) + u(k,j,i) - gu
+             flux_l_w(k,j,tn) = u_comp * (                                    &
+                             ( 37.0_wp * ibit29 * adv_mom_5                   &
+                          +     7.0_wp * ibit28 * adv_mom_3                   &
+                          +              ibit27 * adv_mom_1                   &
+                             ) *                                              &
+                                        ( w(k,j,i)   + w(k,j,i-1) )           &
+                      -      (  8.0_wp * ibit29 * adv_mom_5                   &
+                          +              ibit28 * adv_mom_3                   &
+                             ) *                                              &
+                                        ( w(k,j,i+1) + w(k,j,i-2) )           &
+                      +      (           ibit29 * adv_mom_5                   &
+                             ) *                                              &
+                                        ( w(k,j,i+2) + w(k,j,i-3) )           &
+                                         )
+
+               diss_l_w(k,j,tn) = - ABS( u_comp ) * (                         &
+                             ( 10.0_wp * ibit29 * adv_mom_5                   &
+                          +     3.0_wp * ibit28 * adv_mom_3                   &
+                          +              ibit27 * adv_mom_1                   &
+                             ) *                                              &
+                                        ( w(k,j,i)   - w(k,j,i-1) )           &
+                      -      (  5.0_wp * ibit29 * adv_mom_5                   &
+                          +              ibit28 * adv_mom_3                   &
+                             ) *                                              &
+                                        ( w(k,j,i+1) - w(k,j,i-2) )           &
+                      +      (           ibit29 * adv_mom_5                   &
+                             ) *                                              &
+                                        ( w(k,j,i+2) - w(k,j,i-3) )           &
+                                                    )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             u_comp           = u(k+1,j,i) + u(k,j,i) - gu
+             flux_l_w(k,j,tn) = u_comp * (                                    &
+                            37.0_wp * ( w(k,j,i) + w(k,j,i-1)   )             &
+                          -  8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) )             &
+                          +           ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5
+             diss_l_w(k,j,tn) = - ABS( u_comp ) * (                           &
+                            10.0_wp * ( w(k,j,i) - w(k,j,i-1)   )             &
+                          -  5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) )             &
+                          +           ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5 
+
+          ENDDO
+
+       ENDIF
+!
+!--    The lower flux has to be calculated explicetely for the tendency at
+!--    the first w-level. For topography wall this is done implicitely by
+!--    wall_flags_0.
+       k         = nzb + 1
+       w_comp    = w(k,j,i) + w(k-1,j,i)
+       flux_t(0) = w_comp       * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1
+       diss_t(0) = -ABS(w_comp) * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1
+       flux_d    = flux_t(0)
+       diss_d    = diss_t(0)
+!
+!--    Now compute the fluxes and tendency terms for the horizontal
+!--    and vertical parts.
+       DO  k = nzb+1, nzb_max
+
+          ibit29 = IBITS(wall_flags_0(k,j,i),29,1)
+          ibit28 = IBITS(wall_flags_0(k,j,i),28,1)
+          ibit27 = IBITS(wall_flags_0(k,j,i),27,1)
+
+          u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
+          flux_r(k) = u_comp * (                                              &
+                     ( 37.0_wp * ibit29 * adv_mom_5                           &
+                  +     7.0_wp * ibit28 * adv_mom_3                           &
+                  +              ibit27 * adv_mom_1                           &
+                     ) *                                                      &
+                                    ( w(k,j,i+1) + w(k,j,i)   )               &
+              -      (  8.0_wp * ibit29 * adv_mom_5                           &
+                  +              ibit28 * adv_mom_3                           &
+                     ) *                                                      &
+                                    ( w(k,j,i+2) + w(k,j,i-1) )               &
+              +      (           ibit29 * adv_mom_5                           &
+                     ) *                                                      &
+                                    ( w(k,j,i+3) + w(k,j,i-2) )               &
+                               )
+
+          diss_r(k) = - ABS( u_comp ) * (                                     &
+                     ( 10.0_wp * ibit29 * adv_mom_5                           &
+                  +     3.0_wp * ibit28 * adv_mom_3                           &
+                  +              ibit27 * adv_mom_1                           &
+                     ) *                                                      &
+                                    ( w(k,j,i+1) - w(k,j,i)   )               &
+              -      (  5.0_wp * ibit29 * adv_mom_5                           &
+                  +              ibit28 * adv_mom_3                           &
+                     ) *                                                      &
+                                    ( w(k,j,i+2) - w(k,j,i-1) )               &
+              +      (           ibit29 * adv_mom_5                           &
+                     ) *                                                      &
+                                    ( w(k,j,i+3) - w(k,j,i-2) )               &
+                                        )
+
+          ibit32 = IBITS(wall_flags_00(k,j,i),0,1)
+          ibit31 = IBITS(wall_flags_0(k,j,i),31,1)
+          ibit30 = IBITS(wall_flags_0(k,j,i),30,1)
+
+          v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
+          flux_n(k) = v_comp * (                                              &
+                     ( 37.0_wp * ibit32 * adv_mom_5                           &
+                  +     7.0_wp * ibit31 * adv_mom_3                           &
+                  +              ibit30 * adv_mom_1                           &
+                     ) *                                                      &
+                                    ( w(k,j+1,i) + w(k,j,i)   )               &
+              -      (  8.0_wp * ibit32 * adv_mom_5                           &
+                  +              ibit31 * adv_mom_3                           &
+                     ) *                                                      &
+                                    ( w(k,j+2,i) + w(k,j-1,i) )               &
+              +      (           ibit32 * adv_mom_5                           &
+                     ) *                                                      &
+                                    ( w(k,j+3,i) + w(k,j-2,i) )               &
+                               )
+
+          diss_n(k) = - ABS( v_comp ) * (                                     &
+                     ( 10.0_wp * ibit32 * adv_mom_5                           &
+                  +     3.0_wp * ibit31 * adv_mom_3                           &
+                  +              ibit30 * adv_mom_1                           &
+                     ) *                                                      &
+                                    ( w(k,j+1,i) - w(k,j,i)  )                &
+              -      (  5.0_wp * ibit32 * adv_mom_5                           &
+                  +              ibit31 * adv_mom_3                           &
+                     ) *                                                      &
+                                   ( w(k,j+2,i) - w(k,j-1,i) )                &
+              +      (           ibit32 * adv_mom_5                           &
+                     ) *                                                      &
+                                   ( w(k,j+3,i) - w(k,j-2,i) )                &
+                                        )
+!
+!--       k index has to be modified near bottom and top, else array
+!--       subscripts will be exceeded.
+          ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
+          ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
+          ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
+
+          k_ppp = k + 3 * ibit35
+          k_pp  = k + 2 * ( 1 - ibit33  )
+          k_mm  = k - 2 * ibit35
+
+          w_comp    = w(k+1,j,i) + w(k,j,i)
+          flux_t(k) = w_comp  * (                                             &
+                     ( 37.0_wp * ibit35 * adv_mom_5                           &
+                  +     7.0_wp * ibit34 * adv_mom_3                           &
+                  +              ibit33 * adv_mom_1                           &
+                     ) *                                                      &
+                                ( w(k+1,j,i)  + w(k,j,i)     )                &
+              -      (  8.0_wp * ibit35 * adv_mom_5                           &
+                  +              ibit34 * adv_mom_3                           &
+                     ) *                                                      &
+                                ( w(k_pp,j,i)  + w(k-1,j,i)  )                &
+              +      (           ibit35 * adv_mom_5                           &
+                     ) *                                                      &
+                                ( w(k_ppp,j,i) + w(k_mm,j,i) )                &
+                                )
+
+          diss_t(k) = - ABS( w_comp ) * (                                     &
+                     ( 10.0_wp * ibit35 * adv_mom_5                           &
+                  +     3.0_wp * ibit34 * adv_mom_3                           &
+                  +              ibit33 * adv_mom_1                           &
+                     ) *                                                      &
+                                ( w(k+1,j,i)   - w(k,j,i)    )                &
+              -      (  5.0_wp * ibit35 * adv_mom_5                           &
+                  +              ibit34 * adv_mom_3                           &
+                     ) *                                                      &
+                                ( w(k_pp,j,i)  - w(k-1,j,i)  )                &
+              +      (           ibit35 * adv_mom_5                           &
+                     ) *                                                      &
+                                ( w(k_ppp,j,i) - w(k_mm,j,i) )                &
+                                        )
+
+!
+!--       Calculate the divergence of the velocity field. A respective
+!--       correction is needed to overcome numerical instabilities introduced
+!--       by a not sufficient reduction of divergences near topography. 
+          div = ( ( ( u_comp + gu ) * ( ibit27 + ibit28 + ibit29 )            &
+                  - ( u(k+1,j,i) + u(k,j,i)   )                               & 
+                                    * ( IBITS(wall_flags_0(k,j,i-1),27,1)     &
+                                      + IBITS(wall_flags_0(k,j,i-1),28,1)     &
+                                      + IBITS(wall_flags_0(k,j,i-1),29,1)     &
+                                      )                                       &
+                  ) * ddx                                                     &
+              +   ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 )            & 
+                  - ( v(k+1,j,i) + v(k,j,i)   )                               &
+                                    * ( IBITS(wall_flags_0(k,j-1,i),30,1)     &
+                                      + IBITS(wall_flags_0(k,j-1,i),31,1)     &
+                                      + IBITS(wall_flags_00(k,j-1,i),0,1)     &
+                                      )                                       &
+                  ) * ddy                                                     &
+              +   ( w_comp          * ( ibit33 + ibit34 + ibit35 )            &
+                - ( w(k,j,i)   + w(k-1,j,i)   )                               &
+                                    * ( IBITS(wall_flags_00(k-1,j,i),1,1)     &
+                                      + IBITS(wall_flags_00(k-1,j,i),2,1)     &
+                                      + IBITS(wall_flags_00(k-1,j,i),3,1)     &
+                                      )                                       & 
+                  ) * ddzu(k+1)   &
+                ) * 0.5_wp
+
+
+          tend(k,j,i) = tend(k,j,i) - (                                       &
+                      ( flux_r(k) + diss_r(k)                                 &
+                    -   flux_l_w(k,j,tn) - diss_l_w(k,j,tn)   ) * ddx         &
+                    + ( flux_n(k) + diss_n(k)                                 &
+                    -   flux_s_w(k,tn) - diss_s_w(k,tn)       ) * ddy         &
+                    + ( flux_t(k) + diss_t(k)                                 &
+                    -   flux_d    - diss_d                    ) * ddzu(k+1)   &
+                                      ) + div * w(k,j,i)
+
+          flux_l_w(k,j,tn) = flux_r(k)
+          diss_l_w(k,j,tn) = diss_r(k)
+          flux_s_w(k,tn)   = flux_n(k)
+          diss_s_w(k,tn)   = diss_n(k)
+          flux_d           = flux_t(k)
+          diss_d           = diss_t(k)
+!
+!--        Statistical Evaluation of w'w'.
+          sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                          &
+                             + ( flux_t(k) + diss_t(k) )                      &
+                             *   weight_substep(intermediate_timestep_count)
+
+       ENDDO
+
+       DO  k = nzb_max+1, nzt
+
+          u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
+          flux_r(k) = u_comp * (                                              &
+                      37.0_wp * ( w(k,j,i+1) + w(k,j,i)   )                   &
+                    -  8.0_wp * ( w(k,j,i+2) + w(k,j,i-1) )                   &
+                    +           ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_5
+
+          diss_r(k) = - ABS( u_comp ) * (                                     &
+                      10.0_wp * ( w(k,j,i+1) - w(k,j,i)   )                   &
+                    -  5.0_wp * ( w(k,j,i+2) - w(k,j,i-1) )                   &
+                    +           ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_5
+
+          v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
+          flux_n(k) = v_comp * (                                              &
+                      37.0_wp * ( w(k,j+1,i) + w(k,j,i)   )                   &
+                    -  8.0_wp * ( w(k,j+2,i) + w(k,j-1,i) )                   &
+                    +           ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_5
+
+          diss_n(k) = - ABS( v_comp ) * (                                     &
+                      10.0_wp * ( w(k,j+1,i) - w(k,j,i)   )                   &
+                    -  5.0_wp * ( w(k,j+2,i) - w(k,j-1,i) )                   &
+                    +           ( w(k,j+3,i) - w(k,j-2,i) ) ) * adv_mom_5
+!
+!--       k index has to be modified near bottom and top, else array
+!--       subscripts will be exceeded.
+          ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
+          ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
+          ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
+
+          k_ppp = k + 3 * ibit35
+          k_pp  = k + 2 * ( 1 - ibit33  )
+          k_mm  = k - 2 * ibit35
+
+          w_comp    = w(k+1,j,i) + w(k,j,i)
+          flux_t(k) = w_comp  * (                                             &
+                     ( 37.0_wp * ibit35 * adv_mom_5                           &
+                  +     7.0_wp * ibit34 * adv_mom_3                           &
+                  +              ibit33 * adv_mom_1                           &
+                     ) *                                                      &
+                                ( w(k+1,j,i)  + w(k,j,i)     )                &
+              -      (  8.0_wp * ibit35 * adv_mom_5                           &
+                  +              ibit34 * adv_mom_3                           &
+                     ) *                                                      &
+                                ( w(k_pp,j,i)  + w(k-1,j,i)  )                &
+              +      (           ibit35 * adv_mom_5                           &
+                     ) *                                                      &
+                                ( w(k_ppp,j,i) + w(k_mm,j,i) )                &
+                                )
+
+          diss_t(k) = - ABS( w_comp ) * (                                     &
+                     ( 10.0_wp * ibit35 * adv_mom_5                           &
+                  +     3.0_wp * ibit34 * adv_mom_3                           &
+                  +              ibit33 * adv_mom_1                           &
+                     ) *                                                      &
+                                ( w(k+1,j,i)   - w(k,j,i)    )                &
+              -      (  5.0_wp * ibit35 * adv_mom_5                           &
+                  +              ibit34 * adv_mom_3                           &
+                     ) *                                                      &
+                                ( w(k_pp,j,i)  - w(k-1,j,i)  )                &
+              +      (           ibit35 * adv_mom_5                           &
+                     ) *                                                      &
+                                ( w(k_ppp,j,i) - w(k_mm,j,i) )                &
+                                        )
+!
+!--       Calculate the divergence of the velocity field. A respective
+!--       correction is needed to overcome numerical instabilities introduced
+!--       by a not sufficient reduction of divergences near topography.
+          div = ( ( u_comp + gu - ( u(k+1,j,i) + u(k,j,i)   ) ) * ddx         &
+              +   ( v_comp + gv - ( v(k+1,j,i) + v(k,j,i)   ) ) * ddy         &
+              +   ( w_comp      - ( w(k,j,i)   + w(k-1,j,i) ) ) * ddzu(k+1)   &
+                ) * 0.5_wp
+
+          tend(k,j,i) = tend(k,j,i) - (                                       &
+                      ( flux_r(k) + diss_r(k)                                 &
+                    -   flux_l_w(k,j,tn) - diss_l_w(k,j,tn)   ) * ddx         &
+                    + ( flux_n(k) + diss_n(k)                                 &
+                    -   flux_s_w(k,tn) - diss_s_w(k,tn)       ) * ddy         &
+                    + ( flux_t(k) + diss_t(k)                                 &
+                    -   flux_d    - diss_d                    ) * ddzu(k+1)   &
+                                      ) + div * w(k,j,i)
+
+          flux_l_w(k,j,tn) = flux_r(k)
+          diss_l_w(k,j,tn) = diss_r(k)
+          flux_s_w(k,tn)   = flux_n(k)
+          diss_s_w(k,tn)   = diss_n(k)
+          flux_d           = flux_t(k)
+          diss_d           = diss_t(k)
+!
+!--        Statistical Evaluation of w'w'.
+          sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                          &
+                             + ( flux_t(k) + diss_t(k) )                      &
+                             *   weight_substep(intermediate_timestep_count)
+
+       ENDDO
+
+
+    END SUBROUTINE advec_w_ws_ij
+    
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Scalar advection - Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_s_ws( sk, sk_char )
+
+       USE arrays_3d,                                                         &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE constants,                                                         &
+           ONLY:  adv_sca_1, adv_sca_3, adv_sca_5
+
+       USE control_parameters,                                                &
+           ONLY:  intermediate_timestep_count, monotonic_adjustment, u_gtrans,&
+                  v_gtrans 
+
+       USE grid_variables,                                                    &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                           &
+           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max,   &
+                  nzt, wall_flags_0
+           
+       USE kinds
+       
+       USE statistics,                                                        &
+           ONLY:  sums_wspts_ws_l, sums_wsqs_ws_l, sums_wssas_ws_l,           &
+                  sums_wsqrs_ws_l, sums_wsnrs_ws_l, weight_substep
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN = *), INTENT(IN)    ::  sk_char !<
+       
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  ibit0  !<
+       INTEGER(iwp) ::  ibit1  !<
+       INTEGER(iwp) ::  ibit2  !<
+       INTEGER(iwp) ::  ibit3  !<
+       INTEGER(iwp) ::  ibit4  !<
+       INTEGER(iwp) ::  ibit5  !<
+       INTEGER(iwp) ::  ibit6  !<
+       INTEGER(iwp) ::  ibit7  !<
+       INTEGER(iwp) ::  ibit8  !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  k      !<
+       INTEGER(iwp) ::  k_mm   !<
+       INTEGER(iwp) ::  k_mmm  !<
+       INTEGER(iwp) ::  k_pp   !<
+       INTEGER(iwp) ::  k_ppp  !<
+       INTEGER(iwp) ::  tn = 0 !<
+       
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk !<
+#endif
+
+       REAL(wp) ::  diss_d !<
+       REAL(wp) ::  div    !<
+       REAL(wp) ::  flux_d !<
+       REAL(wp) ::  fd_1   !<
+       REAL(wp) ::  fl_1   !<
+       REAL(wp) ::  fn_1   !<
+       REAL(wp) ::  fr_1   !<
+       REAL(wp) ::  fs_1   !<
+       REAL(wp) ::  ft_1   !<
+       REAL(wp) ::  phi_d  !<
+       REAL(wp) ::  phi_l  !<
+       REAL(wp) ::  phi_n  !<
+       REAL(wp) ::  phi_r  !<
+       REAL(wp) ::  phi_s  !<
+       REAL(wp) ::  phi_t  !<
+       REAL(wp) ::  rd     !<
+       REAL(wp) ::  rl     !<
+       REAL(wp) ::  rn     !<
+       REAL(wp) ::  rr     !<
+       REAL(wp) ::  rs     !<
+       REAL(wp) ::  rt     !<
+       REAL(wp) ::  u_comp !<
+       REAL(wp) ::  v_comp !<
+       
+       REAL(wp), DIMENSION(nzb:nzt)   ::  diss_n !<
+       REAL(wp), DIMENSION(nzb:nzt)   ::  diss_r !<
+       REAL(wp), DIMENSION(nzb:nzt)   ::  diss_t !<
+       REAL(wp), DIMENSION(nzb:nzt)   ::  flux_n !<
+       REAL(wp), DIMENSION(nzb:nzt)   ::  flux_r !<
+       REAL(wp), DIMENSION(nzb:nzt)   ::  flux_t !<
+       
+       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local !<
+       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local !<
+       
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local !<
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local !<
+        
+
+!
+!--    Compute the fluxes for the whole left boundary of the processor domain.
+       i = nxl
+       DO  j = nys, nyn
+
+          DO  k = nzb+1, nzb_max
+
+             ibit2 = IBITS(wall_flags_0(k,j,i-1),2,1)
+             ibit1 = IBITS(wall_flags_0(k,j,i-1),1,1)
+             ibit0 = IBITS(wall_flags_0(k,j,i-1),0,1)
+
+             u_comp                 = u(k,j,i) - u_gtrans
+             swap_flux_x_local(k,j) = u_comp * (                              &
+                                             ( 37.0_wp * ibit2 * adv_sca_5    &
+                                          +     7.0_wp * ibit1 * adv_sca_3    &
+                                          +              ibit0 * adv_sca_1    &
+                                             ) *                              &
+                                          ( sk(k,j,i)   + sk(k,j,i-1)    )    &
+                                      -      (  8.0_wp * ibit2 * adv_sca_5    &
+                                          +              ibit1 * adv_sca_3    &
+                                             ) *                              &
+                                          ( sk(k,j,i+1) + sk(k,j,i-2)    )    &
+                                      +      (           ibit2 * adv_sca_5    & 
+                                             ) *                              &
+                                          ( sk(k,j,i+2) + sk(k,j,i-3)    )    &
+                                               )
+
+              swap_diss_x_local(k,j) = -ABS( u_comp ) * (                     &
+                                             ( 10.0_wp * ibit2 * adv_sca_5    &
+                                          +     3.0_wp * ibit1 * adv_sca_3    &
+                                          +              ibit0 * adv_sca_1    &
+                                             ) *                              &
+                                          ( sk(k,j,i)   - sk(k,j,i-1) )       &
+                                      -      (  5.0_wp * ibit2 * adv_sca_5    &
+                                          +              ibit1 * adv_sca_3    &
+                                             ) *                              &
+                                         ( sk(k,j,i+1) - sk(k,j,i-2)  )       &
+                                      +      (           ibit2 * adv_sca_5    &
+                                             ) *                              &
+                                          ( sk(k,j,i+2) - sk(k,j,i-3) )       &
+                                                        )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             u_comp                 = u(k,j,i) - u_gtrans
+             swap_flux_x_local(k,j) = u_comp * (                              &
+                                      37.0_wp * ( sk(k,j,i)   + sk(k,j,i-1) ) &
+                                    -  8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) ) &
+                                    +           ( sk(k,j,i+2) + sk(k,j,i-3) ) &
+                                               ) * adv_sca_5
+
+             swap_diss_x_local(k,j) = -ABS( u_comp ) * (                      &
+                                      10.0_wp * ( sk(k,j,i)   - sk(k,j,i-1) ) &
+                                    -  5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) ) &
+                                    +           ( sk(k,j,i+2) - sk(k,j,i-3) ) &
+                                                       ) * adv_sca_5
+
+          ENDDO
+
+       ENDDO
+
+       DO  i = nxl, nxr
+
+          j = nys
+          DO  k = nzb+1, nzb_max
+
+             ibit5 = IBITS(wall_flags_0(k,j-1,i),5,1)
+             ibit4 = IBITS(wall_flags_0(k,j-1,i),4,1)
+             ibit3 = IBITS(wall_flags_0(k,j-1,i),3,1)
+
+             v_comp               = v(k,j,i) - v_gtrans
+             swap_flux_y_local(k) = v_comp * (                                &
+                                             ( 37.0_wp * ibit5 * adv_sca_5    &
+                                          +     7.0_wp * ibit4 * adv_sca_3    &
+                                          +              ibit3 * adv_sca_1    &
+                                             ) *                              &
+                                         ( sk(k,j,i)  + sk(k,j-1,i)     )     &
+                                       -     (  8.0_wp * ibit5 * adv_sca_5    &
+                                          +              ibit4 * adv_sca_3    &
+                                              ) *                             &
+                                         ( sk(k,j+1,i) + sk(k,j-2,i)    )     &
+                                      +      (           ibit5 * adv_sca_5    &
+                                             ) *                              &
+                                        ( sk(k,j+2,i) + sk(k,j-3,i)     )     &
+                                             )
+
+             swap_diss_y_local(k) = -ABS( v_comp ) * (                        &
+                                             ( 10.0_wp * ibit5 * adv_sca_5    &
+                                          +     3.0_wp * ibit4 * adv_sca_3    &
+                                          +              ibit3 * adv_sca_1    &
+                                             ) *                              &
+                                          ( sk(k,j,i)   - sk(k,j-1,i)    )    &
+                                      -      (  5.0_wp * ibit5 * adv_sca_5    &
+                                          +              ibit4 * adv_sca_3    &
+                                             ) *                              &
+                                          ( sk(k,j+1,i) - sk(k,j-2,i)    )    &
+                                      +      (           ibit5 * adv_sca_5    &
+                                             ) *                              &
+                                          ( sk(k,j+2,i) - sk(k,j-3,i)    )    &
+                                                     )
+
+          ENDDO
+!
+!--       Above to the top of the highest topography. No degradation necessary.
+          DO  k = nzb_max+1, nzt
+
+             v_comp               = v(k,j,i) - v_gtrans
+             swap_flux_y_local(k) = v_comp * (                               &
+                                    37.0_wp * ( sk(k,j,i)   + sk(k,j-1,i) )  &
+                                  -  8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) )  &
+                                  +           ( sk(k,j+2,i) + sk(k,j-3,i) )  &
+                                             ) * adv_sca_5
+              swap_diss_y_local(k) = -ABS( v_comp ) * (                      &
+                                    10.0_wp * ( sk(k,j,i)   - sk(k,j-1,i) )  &
+                                  -  5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) )  &
+                                  +             sk(k,j+2,i) - sk(k,j-3,i)    &
+                                                      ) * adv_sca_5
+
+          ENDDO
+
+          DO  j = nys, nyn
+
+             flux_t(0) = 0.0_wp
+             diss_t(0) = 0.0_wp
+             flux_d    = 0.0_wp
+             diss_d    = 0.0_wp
+
+             DO  k = nzb+1, nzb_max
+
+                ibit2 = IBITS(wall_flags_0(k,j,i),2,1)
+                ibit1 = IBITS(wall_flags_0(k,j,i),1,1)
+                ibit0 = IBITS(wall_flags_0(k,j,i),0,1)
+
+                u_comp    = u(k,j,i+1) - u_gtrans
+                flux_r(k) = u_comp * (                                        &
+                          ( 37.0_wp * ibit2 * adv_sca_5                       &
+                      +      7.0_wp * ibit1 * adv_sca_3                       &
+                      +               ibit0 * adv_sca_1                       &
+                          ) *                                                 &
+                             ( sk(k,j,i+1) + sk(k,j,i)   )                    &
+                   -      (  8.0_wp * ibit2 * adv_sca_5                       &
+                       +              ibit1 * adv_sca_3                       &
+                          ) *                                                 &
+                             ( sk(k,j,i+2) + sk(k,j,i-1) )                    &
+                   +      (           ibit2 * adv_sca_5                       &
+                          ) *                                                 &
+                             ( sk(k,j,i+3) + sk(k,j,i-2) )                    &
+                                     )
+
+                diss_r(k) = -ABS( u_comp ) * (                                &
+                          ( 10.0_wp * ibit2 * adv_sca_5                       &
+                       +     3.0_wp * ibit1 * adv_sca_3                       &
+                       +              ibit0 * adv_sca_1                       &
+                          ) *                                                 &
+                             ( sk(k,j,i+1) - sk(k,j,i)   )                    &
+                   -      (  5.0_wp * ibit2 * adv_sca_5                       &
+                       +              ibit1 * adv_sca_3                       &
+                          ) *                                                 &
+                             ( sk(k,j,i+2) - sk(k,j,i-1) )                    &
+                   +      (           ibit2 * adv_sca_5                       &
+                          ) *                                                 &
+                             ( sk(k,j,i+3) - sk(k,j,i-2) )                    &
+                                             )
+
+                ibit5 = IBITS(wall_flags_0(k,j,i),5,1)
+                ibit4 = IBITS(wall_flags_0(k,j,i),4,1)
+                ibit3 = IBITS(wall_flags_0(k,j,i),3,1)
+
+                v_comp    = v(k,j+1,i) - v_gtrans
+                flux_n(k) = v_comp * (                                        &
+                          ( 37.0_wp * ibit5 * adv_sca_5                       &
+                       +     7.0_wp * ibit4 * adv_sca_3                       &
+                       +              ibit3 * adv_sca_1                       &
+                          ) *                                                 &
+                             ( sk(k,j+1,i) + sk(k,j,i)   )                    &
+                   -      (  8.0_wp * ibit5 * adv_sca_5                       &
+                       +              ibit4 * adv_sca_3                       &
+                          ) *                                                 &
+                             ( sk(k,j+2,i) + sk(k,j-1,i) )                    &
+                   +      (           ibit5 * adv_sca_5                       &
+                          ) *                                                 &
+                             ( sk(k,j+3,i) + sk(k,j-2,i) )                    &
+                                     )
+
+                diss_n(k) = -ABS( v_comp ) * (                                &
+                          ( 10.0_wp * ibit5 * adv_sca_5                       &
+                       +     3.0_wp * ibit4 * adv_sca_3                       &
+                       +              ibit3 * adv_sca_1                       &
+                          ) *                                                 &
+                             ( sk(k,j+1,i) - sk(k,j,i)    )                   &
+                   -      (  5.0_wp * ibit5 * adv_sca_5                       &
+                       +              ibit4 * adv_sca_3                       &
+                          ) *                                                 &
+                             ( sk(k,j+2,i) - sk(k,j-1,i)  )                   &
+                   +      (           ibit5 * adv_sca_5                       &
+                          ) *                                                 &
+                             ( sk(k,j+3,i) - sk(k,j-2,i) )                    &
+                                             )
+!
+!--             k index has to be modified near bottom and top, else array
+!--             subscripts will be exceeded.
+                ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
+                ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
+                ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
+
+                k_ppp = k + 3 * ibit8
+                k_pp  = k + 2 * ( 1 - ibit6  )
+                k_mm  = k - 2 * ibit8
+
+
+                flux_t(k) = w(k,j,i) * (                                      &
+                           ( 37.0_wp * ibit8 * adv_sca_5                      &
+                        +     7.0_wp * ibit7 * adv_sca_3                      &
+                        +           ibit6 * adv_sca_1                         &
+                           ) *                                                &
+                                   ( sk(k+1,j,i)  + sk(k,j,i)    )            &
+                    -      (  8.0_wp * ibit8 * adv_sca_5                      &
+                        +              ibit7 * adv_sca_3                      &
+                           ) *                                                &
+                                   ( sk(k_pp,j,i) + sk(k-1,j,i)  )            &
+                    +      (           ibit8 * adv_sca_5                      &
+                           ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )            &
+                                       )
+
+                diss_t(k) = -ABS( w(k,j,i) ) * (                              &
+                           ( 10.0_wp * ibit8 * adv_sca_5                      &
+                        +     3.0_wp * ibit7 * adv_sca_3                      &
+                        +              ibit6 * adv_sca_1                      &
+                           ) *                                                &
+                                   ( sk(k+1,j,i)   - sk(k,j,i)    )           &
+                    -      (  5.0_wp * ibit8 * adv_sca_5                      &
+                        +              ibit7 * adv_sca_3                      &
+                           ) *                                                &
+                                   ( sk(k_pp,j,i)  - sk(k-1,j,i)  )           &
+                    +      (           ibit8 * adv_sca_5                      &
+                           ) *                                                &
+                                   ( sk(k_ppp,j,i) - sk(k_mm,j,i) )           &
+                                               )
+!
+!--             Apply monotonic adjustment.
+                IF ( monotonic_adjustment )  THEN
+!
+!--                At first, calculate first order fluxes.
+                   u_comp = u(k,j,i) - u_gtrans
+                   fl_1   =  ( u_comp   * ( sk(k,j,i) + sk(k,j,i-1) )         &
+                         -ABS( u_comp ) * ( sk(k,j,i) - sk(k,j,i-1) )         &
+                             ) * adv_sca_1 
+
+                   u_comp = u(k,j,i+1) - u_gtrans
+                   fr_1   =  ( u_comp   * ( sk(k,j,i+1) + sk(k,j,i) )         &
+                         -ABS( u_comp ) * ( sk(k,j,i+1) - sk(k,j,i) )         &
+                             ) * adv_sca_1 
+
+                   v_comp = v(k,j,i) - v_gtrans
+                   fs_1   =  ( v_comp   * ( sk(k,j,i) + sk(k,j-1,i) )         &
+                         -ABS( v_comp ) * ( sk(k,j,i) - sk(k,j-1,i) )         &
+                             ) * adv_sca_1 
+
+                   v_comp = v(k,j+1,i) - v_gtrans
+                   fn_1   =  ( v_comp   * ( sk(k,j+1,i) + sk(k,j,i) )         &
+                         -ABS( v_comp ) * ( sk(k,j+1,i) - sk(k,j,i) )         &
+                             ) * adv_sca_1 
+
+                   fd_1   = (  w(k-1,j,i)   * ( sk(k,j,i) + sk(k-1,j,i) )     &
+                         -ABS( w(k-1,j,i) ) * ( sk(k,j,i) - sk(k-1,j,i) )     &
+                            ) * adv_sca_1 
+
+                   ft_1   = (  w(k,j,i)   * ( sk(k+1,j,i) + sk(k,j,i) )       &
+                         -ABS( w(k,j,i) ) * ( sk(k+1,j,i) - sk(k,j,i) )       &
+                            ) * adv_sca_1 
+!
+!--                Calculate ratio of upwind gradients. Note, Min/Max is just
+!--                to avoid if statements.
+                   rl     = ( MAX( 0.0_wp, u(k,j,i) - u_gtrans ) *            & 
+                               ABS( ( sk(k,j,i-1) - sk(k,j,i-2)            ) /&
+                                    ( sk(k,j,i)   - sk(k,j,i-1) + 1E-20_wp )  &
+                                  ) +                                         & 
+                              MIN( 0.0_wp, u(k,j,i) - u_gtrans ) *            &
+                               ABS( ( sk(k,j,i)   - sk(k,j,i+1)            ) /&
+                                    ( sk(k,j,i-1) - sk(k,j,i)   + 1E-20_wp )  &
+                                  )                                           &
+                            ) / ABS( u(k,j,i) - u_gtrans + 1E-20_wp )
+
+                   rr     = ( MAX( 0.0_wp, u(k,j,i+1) - u_gtrans ) *          & 
+                               ABS( ( sk(k,j,i)   - sk(k,j,i-1)            ) /&
+                                    ( sk(k,j,i+1) - sk(k,j,i)   + 1E-20_wp )  &
+                                  ) +                                         & 
+                              MIN( 0.0_wp, u(k,j,i+1) - u_gtrans ) *          &
+                               ABS( ( sk(k,j,i+1) - sk(k,j,i+2)            ) /&
+                                    ( sk(k,j,i)   - sk(k,j,i+1) + 1E-20_wp )  &
+                                  )                                           &
+                            ) / ABS( u(k,j,i+1) - u_gtrans + 1E-20_wp )
+
+                   rs     = ( MAX( 0.0_wp, v(k,j,i) - v_gtrans ) *            & 
+                               ABS( ( sk(k,j-1,i) - sk(k,j-2,i)            ) /&
+                                    ( sk(k,j,i)   - sk(k,j-1,i) + 1E-20_wp )  &
+                                  ) +                                         & 
+                              MIN( 0.0_wp, v(k,j,i) - v_gtrans ) *            &
+                               ABS( ( sk(k,j,i)   - sk(k,j+1,i)            ) /&
+                                    ( sk(k,j-1,i) - sk(k,j,i)   + 1E-20_wp )  &
+                                  )                                           &
+                            ) / ABS( v(k,j,i) - v_gtrans + 1E-20_wp )
+
+                   rn     = ( MAX( 0.0_wp, v(k,j+1,i) - v_gtrans ) *          & 
+                               ABS( ( sk(k,j,i)   - sk(k,j-1,i)            ) /&
+                                    ( sk(k,j+1,i) - sk(k,j,i)   + 1E-20_wp )  &
+                                  ) +                                         & 
+                              MIN( 0.0_wp, v(k,j+1,i) - v_gtrans ) *          &
+                               ABS( ( sk(k,j+1,i) - sk(k,j+2,i)            ) /&
+                                    ( sk(k,j,i)   - sk(k,j+1,i) + 1E-20_wp )  &
+                                  )                                           &
+                            ) / ABS( v(k,j+1,i) - v_gtrans + 1E-20_wp )     
+!   
+!--                Reuse k_mm and compute k_mmm for the vertical gradient ratios. 
+!--                Note, for vertical advection below the third grid point above 
+!--                surface ( or below the model top) rd and rt are set to 0, i.e. 
+!--                use of first order scheme is enforced.
+                   k_mmm  = k - 3 * ibit8
+
+                   rd     = ( MAX( 0.0_wp, w(k-1,j,i) ) *                     & 
+                            ABS( ( sk(k_mm,j,i) - sk(k_mmm,j,i)           ) / &
+                                 ( sk(k-1,j,i)  - sk(k_mm,j,i) + 1E-20_wp )   &
+                               ) +                                            & 
+                              MIN( 0.0_wp, w(k-1,j,i) ) *                     &
+                            ABS( ( sk(k-1,j,i) - sk(k,j,i)            ) /     &
+                                 ( sk(k_mm,j,i) - sk(k-1,j,i)   + 1E-20_wp )  &
+                               )                                              &
+                            ) * ibit8 / ABS( w(k-1,j,i) + 1E-20_wp ) 
+ 
+                   rt     = ( MAX( 0.0_wp, w(k,j,i) ) *                       & 
+                            ABS( ( sk(k,j,i)   - sk(k-1,j,i)            ) /   &
+                                 ( sk(k+1,j,i) - sk(k,j,i)   + 1E-20_wp )     &
+                               ) +                                            & 
+                              MIN( 0.0_wp, w(k,j,i) ) *                       &
+                            ABS( ( sk(k+1,j,i) - sk(k_pp,j,i)           ) /   &
+                                 ( sk(k,j,i)   - sk(k+1,j,i) + 1E-20_wp )     &
+                               )                                              &
+                            ) * ibit8 / ABS( w(k,j,i) + 1E-20_wp )
+!
+!--                Calculate empirical limiter function (van Albada2 limiter).
+                   phi_l = MIN( 1.0_wp, ( 2.0_wp * ABS( rl ) ) /              &
+                                        ( rl**2 + 1.0_wp ) ) 
+                   phi_r = MIN( 1.0_wp, ( 2.0_wp * ABS( rr ) ) /              &
+                                        ( rr**2 + 1.0_wp ) ) 
+                   phi_s = MIN( 1.0_wp, ( 2.0_wp * ABS( rs ) ) /              &
+                                        ( rs**2 + 1.0_wp ) ) 
+                   phi_n = MIN( 1.0_wp, ( 2.0_wp * ABS( rn ) ) /              &
+                                        ( rn**2 + 1.0_wp ) ) 
+                   phi_d = MIN( 1.0_wp, ( 2.0_wp * ABS( rd ) ) /              &
+                                        ( rd**2 + 1.0_wp ) ) 
+                   phi_t = MIN( 1.0_wp, ( 2.0_wp * ABS( rt ) ) /              &
+                                        ( rt**2 + 1.0_wp ) ) 
+!
+!--                Calculate the resulting monotone flux. 
+                   swap_flux_x_local(k,j) = fl_1 - phi_l *                    &
+                                          ( fl_1 - swap_flux_x_local(k,j) )
+                   flux_r(k)              = fr_1 - phi_r *                    &
+                                          ( fr_1 - flux_r(k)              )
+                   swap_flux_y_local(k)   = fs_1 - phi_s *                    &
+                                          ( fs_1 - swap_flux_y_local(k)   )
+                   flux_n(k)              = fn_1 - phi_n *                    &
+                                          ( fn_1 - flux_n(k)              )
+                   flux_d                 = fd_1 - phi_d *                    &
+                                          ( fd_1 - flux_d                 )
+                   flux_t(k)              = ft_1 - phi_t *                    &
+                                          ( ft_1 - flux_t(k)              )
+!
+!--                Moreover, modify dissipation flux according to the limiter. 
+                   swap_diss_x_local(k,j) = swap_diss_x_local(k,j) * phi_l
+                   diss_r(k)              = diss_r(k)              * phi_r
+                   swap_diss_y_local(k)   = swap_diss_y_local(k)   * phi_s
+                   diss_n(k)              = diss_n(k)              * phi_n
+                   diss_d                 = diss_d                 * phi_d
+                   diss_t(k)              = diss_t(k)              * phi_t
+
+                ENDIF
+!
+!--             Calculate the divergence of the velocity field. A respective
+!--             correction is needed to overcome numerical instabilities caused
+!--             by a not sufficient reduction of divergences near topography.
+                div   =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )             &
+                          - u(k,j,i)   * ( IBITS(wall_flags_0(k,j,i-1),0,1)    &
+                                         + IBITS(wall_flags_0(k,j,i-1),1,1)    &
+                                         + IBITS(wall_flags_0(k,j,i-1),2,1)    &
+                                         )                                     &
+                          ) * ddx                                              &
+                        + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )             &
+                          - v(k,j,i)   * ( IBITS(wall_flags_0(k,j-1,i),3,1)    &
+                                         + IBITS(wall_flags_0(k,j-1,i),4,1)    &
+                                         + IBITS(wall_flags_0(k,j-1,i),5,1)    &
+                                         )                                     &
+                          ) * ddy                                              &
+                        + ( w(k,j,i)   * ( ibit6 + ibit7 + ibit8 )             &
+                          - w(k-1,j,i) * ( IBITS(wall_flags_0(k-1,j,i),6,1)    &
+                                         + IBITS(wall_flags_0(k-1,j,i),7,1)    &
+                                         + IBITS(wall_flags_0(k-1,j,i),8,1)    &
+                                         )                                     &      
+                          ) * ddzw(k)
+
+
+                tend(k,j,i) = tend(k,j,i) - (                                 &
+                        ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j) -    &
+                          swap_diss_x_local(k,j)            ) * ddx           &
+                      + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k)   -    &
+                          swap_diss_y_local(k)              ) * ddy           &
+                      + ( flux_t(k) + diss_t(k) - flux_d - diss_d             &
+                                                               ) * ddzw(k)    &
+                                            ) + sk(k,j,i) * div
+
+                swap_flux_y_local(k)   = flux_n(k)
+                swap_diss_y_local(k)   = diss_n(k)
+                swap_flux_x_local(k,j) = flux_r(k)
+                swap_diss_x_local(k,j) = diss_r(k)
+                flux_d                 = flux_t(k)
+                diss_d                 = diss_t(k)
+
+             ENDDO
+
+             DO  k = nzb_max+1, nzt
+
+                u_comp    = u(k,j,i+1) - u_gtrans
+                flux_r(k) = u_comp * (                                        &
+                      37.0_wp * ( sk(k,j,i+1) + sk(k,j,i)   )                 &
+                    -  8.0_wp * ( sk(k,j,i+2) + sk(k,j,i-1) )                 &
+                    +           ( sk(k,j,i+3) + sk(k,j,i-2) ) ) * adv_sca_5
+                diss_r(k) = -ABS( u_comp ) * (                                &
+                      10.0_wp * ( sk(k,j,i+1) - sk(k,j,i)   )                 &
+                    -  5.0_wp * ( sk(k,j,i+2) - sk(k,j,i-1) )                 &
+                    +           ( sk(k,j,i+3) - sk(k,j,i-2) ) ) * adv_sca_5
+
+                v_comp    = v(k,j+1,i) - v_gtrans
+                flux_n(k) = v_comp * (                                        &
+                      37.0_wp * ( sk(k,j+1,i) + sk(k,j,i)   )                 &
+                    -  8.0_wp * ( sk(k,j+2,i) + sk(k,j-1,i) )                 &
+                    +           ( sk(k,j+3,i) + sk(k,j-2,i) ) ) * adv_sca_5
+                diss_n(k) = -ABS( v_comp ) * (                                &
+                      10.0_wp * ( sk(k,j+1,i) - sk(k,j,i)   )                 &
+                    -  5.0_wp * ( sk(k,j+2,i) - sk(k,j-1,i) )                 &
+                    +           ( sk(k,j+3,i) - sk(k,j-2,i) ) ) * adv_sca_5
+!
+!--             k index has to be modified near bottom and top, else array
+!--             subscripts will be exceeded.
+                ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
+                ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
+                ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
+
+                k_ppp = k + 3 * ibit8
+                k_pp  = k + 2 * ( 1 - ibit6  )
+                k_mm  = k - 2 * ibit8
+
+
+                flux_t(k) = w(k,j,i) * (                                      &
+                           ( 37.0_wp * ibit8 * adv_sca_5                      &
+                        +     7.0_wp * ibit7 * adv_sca_3                      &
+                        +              ibit6 * adv_sca_1                      &
+                           ) *                                                &
+                                   ( sk(k+1,j,i)  + sk(k,j,i)     )           &
+                    -      (  8.0_wp * ibit8 * adv_sca_5                      &
+                        +              ibit7 * adv_sca_3                      &
+                           ) *                                                &
+                                   ( sk(k_pp,j,i) + sk(k-1,j,i)   )           &
+                    +      (           ibit8 * adv_sca_5                      &
+                           ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i)  )           &
+                                       )
+
+                diss_t(k) = -ABS( w(k,j,i) ) * (                              &
+                           ( 10.0_wp * ibit8 * adv_sca_5                      &
+                        +     3.0_wp * ibit7 * adv_sca_3                      &
+                        +              ibit6 * adv_sca_1                      &
+                           ) *                                                &
+                                   ( sk(k+1,j,i)   - sk(k,j,i)    )           &
+                    -      (  5.0_wp * ibit8 * adv_sca_5                      &
+                        +              ibit7 * adv_sca_3                      &
+                           ) *                                                &
+                                   ( sk(k_pp,j,i)  - sk(k-1,j,i)  )           &
+                    +      (           ibit8 * adv_sca_5                      &
+                           ) *                                                &
+                                   ( sk(k_ppp,j,i) - sk(k_mm,j,i) )           &
+                                               )
+!
+!--             Apply monotonic adjustment.
+                IF ( monotonic_adjustment )  THEN
+!
+!--                At first, calculate first order fluxes.
+                   u_comp = u(k,j,i) - u_gtrans
+                   fl_1   =  ( u_comp   * ( sk(k,j,i) + sk(k,j,i-1) )         &
+                         -ABS( u_comp ) * ( sk(k,j,i) - sk(k,j,i-1) )         &
+                             ) * adv_sca_1 
+
+                   u_comp = u(k,j,i+1) - u_gtrans
+                   fr_1   =  ( u_comp   * ( sk(k,j,i+1) + sk(k,j,i) )         &
+                         -ABS( u_comp ) * ( sk(k,j,i+1) - sk(k,j,i) )         &
+                             ) * adv_sca_1 
+
+                   v_comp = v(k,j,i) - v_gtrans
+                   fs_1   =  ( v_comp   * ( sk(k,j,i) + sk(k,j-1,i) )         &
+                         -ABS( v_comp ) * ( sk(k,j,i) - sk(k,j-1,i) )         &
+                             ) * adv_sca_1 
+
+                   v_comp = v(k,j+1,i) - v_gtrans
+                   fn_1   =  ( v_comp   * ( sk(k,j+1,i) + sk(k,j,i) )         &
+                         -ABS( v_comp ) * ( sk(k,j+1,i) - sk(k,j,i) )         &
+                             ) * adv_sca_1 
+
+                   fd_1   = (  w(k-1,j,i)   * ( sk(k,j,i) + sk(k-1,j,i) )     &
+                         -ABS( w(k-1,j,i) ) * ( sk(k,j,i) - sk(k-1,j,i) )     &
+                            ) * adv_sca_1 
+
+                   ft_1   = (  w(k,j,i)   * ( sk(k+1,j,i) + sk(k,j,i) )       &
+                         -ABS( w(k,j,i) ) * ( sk(k+1,j,i) - sk(k,j,i) )       &
+                            ) * adv_sca_1 
+!
+!--                Calculate ratio of upwind gradients. Note, Min/Max is just
+!--                to avoid if statements.
+                   rl     = ( MAX( 0.0_wp, u(k,j,i) - u_gtrans ) *            & 
+                               ABS( ( sk(k,j,i-1) - sk(k,j,i-2)            ) /&
+                                    ( sk(k,j,i)   - sk(k,j,i-1) + 1E-20_wp )  &
+                                  ) +                                         & 
+                              MIN( 0.0_wp, u(k,j,i) - u_gtrans ) *            &
+                               ABS( ( sk(k,j,i)   - sk(k,j,i+1)            ) /&
+                                    ( sk(k,j,i-1) - sk(k,j,i)   + 1E-20_wp )  &
+                                  )                                           &
+                            ) / ABS( u(k,j,i) - u_gtrans + 1E-20_wp )
+
+                   rr     = ( MAX( 0.0_wp, u(k,j,i+1) - u_gtrans ) *          & 
+                               ABS( ( sk(k,j,i)   - sk(k,j,i-1)            ) /&
+                                    ( sk(k,j,i+1) - sk(k,j,i)   + 1E-20_wp )  &
+                                  ) +                                         & 
+                              MIN( 0.0_wp, u(k,j,i+1) - u_gtrans ) *          &
+                               ABS( ( sk(k,j,i+1) - sk(k,j,i+2)            ) /&
+                                    ( sk(k,j,i)   - sk(k,j,i+1) + 1E-20_wp )  &
+                                  )                                           &
+                            ) / ABS( u(k,j,i+1) - u_gtrans + 1E-20_wp )
+
+                   rs     = ( MAX( 0.0_wp, v(k,j,i) - v_gtrans ) *            & 
+                               ABS( ( sk(k,j-1,i) - sk(k,j-2,i)            ) /&
+                                    ( sk(k,j,i)   - sk(k,j-1,i) + 1E-20_wp )  &
+                                  ) +                                         & 
+                              MIN( 0.0_wp, v(k,j,i) - v_gtrans ) *            &
+                               ABS( ( sk(k,j,i)   - sk(k,j+1,i)            ) /&
+                                    ( sk(k,j-1,i) - sk(k,j,i)   + 1E-20_wp )  &
+                                  )                                           &
+                            ) / ABS( v(k,j,i) - v_gtrans + 1E-20_wp )
+
+                   rn     = ( MAX( 0.0_wp, v(k,j+1,i) - v_gtrans ) *          & 
+                               ABS( ( sk(k,j,i)   - sk(k,j-1,i)            ) /&
+                                    ( sk(k,j+1,i) - sk(k,j,i)   + 1E-20_wp )  &
+                                  ) +                                         & 
+                              MIN( 0.0_wp, v(k,j+1,i) - v_gtrans ) *          &
+                               ABS( ( sk(k,j+1,i) - sk(k,j+2,i)            ) /&
+                                    ( sk(k,j,i)   - sk(k,j+1,i) + 1E-20_wp )  &
+                                  )                                           &
+                            ) / ABS( v(k,j+1,i) - v_gtrans + 1E-20_wp )     
+!   
+!--                Reuse k_mm and compute k_mmm for the vertical gradient ratios. 
+!--                Note, for vertical advection below the third grid point above 
+!--                surface ( or below the model top) rd and rt are set to 0, i.e. 
+!--                use of first order scheme is enforced.
+                   k_mmm  = k - 3 * ibit8
+
+                   rd     = ( MAX( 0.0_wp, w(k-1,j,i) ) *                     & 
+                            ABS( ( sk(k_mm,j,i) - sk(k_mmm,j,i)           ) / &
+                                 ( sk(k-1,j,i)  - sk(k_mm,j,i) + 1E-20_wp )   &
+                               ) +                                            & 
+                              MIN( 0.0_wp, w(k-1,j,i) ) *                     &
+                            ABS( ( sk(k-1,j,i) - sk(k,j,i)            ) /     &
+                                 ( sk(k_mm,j,i) - sk(k-1,j,i)   + 1E-20_wp )  &
+                               )                                              &
+                            ) * ibit8 / ABS( w(k-1,j,i) + 1E-20_wp ) 
+ 
+                   rt     = ( MAX( 0.0_wp, w(k,j,i) ) *                       & 
+                            ABS( ( sk(k,j,i)   - sk(k-1,j,i)            ) /   &
+                                 ( sk(k+1,j,i) - sk(k,j,i)   + 1E-20_wp )     &
+                               ) +                                            & 
+                              MIN( 0.0_wp, w(k,j,i) ) *                       &
+                            ABS( ( sk(k+1,j,i) - sk(k_pp,j,i)           ) /   &
+                                 ( sk(k,j,i)   - sk(k+1,j,i) + 1E-20_wp )     &
+                               )                                              &
+                            ) * ibit8 / ABS( w(k,j,i) + 1E-20_wp ) 
+!
+!--                Calculate empirical limiter function (van Albada2 limiter).
+                   phi_l = MIN( 1.0_wp, ( 2.0_wp * ABS( rl ) ) /              &
+                                        ( rl**2 + 1.0_wp ) ) 
+                   phi_r = MIN( 1.0_wp, ( 2.0_wp * ABS( rr ) ) /              &
+                                        ( rr**2 + 1.0_wp ) ) 
+                   phi_s = MIN( 1.0_wp, ( 2.0_wp * ABS( rs ) ) /              &
+                                        ( rs**2 + 1.0_wp ) ) 
+                   phi_n = MIN( 1.0_wp, ( 2.0_wp * ABS( rn ) ) /              &
+                                        ( rn**2 + 1.0_wp ) ) 
+                   phi_d = MIN( 1.0_wp, ( 2.0_wp * ABS( rd ) ) /              &
+                                        ( rd**2 + 1.0_wp ) ) 
+                   phi_t = MIN( 1.0_wp, ( 2.0_wp * ABS( rt ) ) /              &
+                                        ( rt**2 + 1.0_wp ) ) 
+!
+!--                Calculate the resulting monotone flux. 
+                   swap_flux_x_local(k,j) = fl_1 - phi_l *                    &
+                                          ( fl_1 - swap_flux_x_local(k,j) )
+                   flux_r(k)              = fr_1 - phi_r *                    &
+                                          ( fr_1 - flux_r(k)              )
+                   swap_flux_y_local(k)   = fs_1 - phi_s *                    &
+                                          ( fs_1 - swap_flux_y_local(k)   )
+                   flux_n(k)              = fn_1 - phi_n *                    &
+                                          ( fn_1 - flux_n(k)              )
+                   flux_d                 = fd_1 - phi_d *                    &
+                                          ( fd_1 - flux_d                 )
+                   flux_t(k)              = ft_1 - phi_t *                    &
+                                          ( ft_1 - flux_t(k)              )
+!
+!--                Moreover, modify dissipation flux according to the limiter. 
+                   swap_diss_x_local(k,j) = swap_diss_x_local(k,j) * phi_l
+                   diss_r(k)              = diss_r(k)              * phi_r
+                   swap_diss_y_local(k)   = swap_diss_y_local(k)   * phi_s
+                   diss_n(k)              = diss_n(k)              * phi_n
+                   diss_d                 = diss_d                 * phi_d
+                   diss_t(k)              = diss_t(k)              * phi_t
+
+                ENDIF
+!
+!--             Calculate the divergence of the velocity field. A respective
+!--             correction is needed to overcome numerical instabilities introduced
+!--             by a not sufficient reduction of divergences near topography.
+                div         =   ( u(k,j,i+1) - u(k,j,i)   ) * ddx             &
+                              + ( v(k,j+1,i) - v(k,j,i)   ) * ddy             &
+                              + ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)
+
+                tend(k,j,i) = tend(k,j,i) - (                                 &
+                        ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j) -    &
+                          swap_diss_x_local(k,j)            ) * ddx           &
+                      + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k)   -    &
+                          swap_diss_y_local(k)              ) * ddy           &
+                      + ( flux_t(k) + diss_t(k) - flux_d - diss_d             &
+                                                               ) * ddzw(k)    &
+                                            ) + sk(k,j,i) * div
+
+                swap_flux_y_local(k)   = flux_n(k)
+                swap_diss_y_local(k)   = diss_n(k)
+                swap_flux_x_local(k,j) = flux_r(k)
+                swap_diss_x_local(k,j) = diss_r(k)
+                flux_d                 = flux_t(k)
+                diss_d                 = diss_t(k)
+
+             ENDDO
+!
+!--          Evaluation of statistics. 
+             SELECT CASE ( sk_char )
+
+                 CASE ( 'pt' )
+                    DO  k = nzb, nzt
+                       sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn)          &
+                        + ( flux_t(k) + diss_t(k) )                           &
+                        *   weight_substep(intermediate_timestep_count)
+                    ENDDO
+                 CASE ( 'sa' )
+                    DO  k = nzb, nzt
+                       sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn)          &
+                        + ( flux_t(k) + diss_t(k) )                           &
+                        *   weight_substep(intermediate_timestep_count)
+                    ENDDO
+                 CASE ( 'q' )
+                    DO  k = nzb, nzt
+                       sums_wsqs_ws_l(k,tn) = sums_wsqs_ws_l(k,tn)            &
+                        + ( flux_t(k) + diss_t(k) )                           &
+                        *   weight_substep(intermediate_timestep_count)
+                    ENDDO
+                 CASE ( 'qr' )
+                    DO  k = nzb, nzt
+                       sums_wsqrs_ws_l(k,tn) = sums_wsqrs_ws_l(k,tn)          &
+                        + ( flux_t(k) + diss_t(k) )                           &
+                        *   weight_substep(intermediate_timestep_count)
+                    ENDDO
+                 CASE ( 'nr' )
+                    DO  k = nzb, nzt
+                       sums_wsnrs_ws_l(k,tn) = sums_wsnrs_ws_l(k,tn)          &
+                        + ( flux_t(k) + diss_t(k) )                           &
+                        *   weight_substep(intermediate_timestep_count)
+                    ENDDO
+
+              END SELECT
+
+         ENDDO
+      ENDDO
+
+    END SUBROUTINE advec_s_ws
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Scalar advection - Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_s_ws_acc ( sk, sk_char )
+
+       USE arrays_3d,                                                         &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE constants,                                                         &
+           ONLY:  adv_sca_1, adv_sca_3, adv_sca_5
+
+       USE control_parameters,                                                &
+           ONLY:  intermediate_timestep_count, monotonic_adjustment, u_gtrans,&
+                  v_gtrans
+
+       USE grid_variables,                                                    &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                           &
+           ONLY:  i_left, i_right, j_north, j_south, nxlg, nxrg, nyng, nysg,  &
+                  nzb, nzb_max, nzt, wall_flags_0
+
+       USE kinds
+       
+!        USE statistics,                                                       &
+!            ONLY:  sums_wspts_ws_l, sums_wsqs_ws_l, sums_wssas_ws_l,          &
+!                   sums_wsqrs_ws_l, sums_wsnrs_ws_l, weight_substep
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN = *), INTENT(IN)    :: sk_char !<
+
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  ibit0  !<
+       INTEGER(iwp) ::  ibit1  !<
+       INTEGER(iwp) ::  ibit2  !<
+       INTEGER(iwp) ::  ibit3  !<
+       INTEGER(iwp) ::  ibit4  !<
+       INTEGER(iwp) ::  ibit5  !<
+       INTEGER(iwp) ::  ibit6  !<
+       INTEGER(iwp) ::  ibit7  !<
+       INTEGER(iwp) ::  ibit8  !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  k      !<
+       INTEGER(iwp) ::  k_mm   !<
+       INTEGER(iwp) ::  k_mmm  !<
+       INTEGER(iwp) ::  k_pp   !<
+       INTEGER(iwp) ::  k_ppp  !<
+       INTEGER(iwp) ::  tn = 0 !<
+
+       REAL(wp)    ::  diss_d !<
+       REAL(wp)    ::  diss_l !<
+       REAL(wp)    ::  diss_n !<
+       REAL(wp)    ::  diss_r !<
+       REAL(wp)    ::  diss_s !<
+       REAL(wp)    ::  diss_t !<
+       REAL(wp)    ::  div    !<
+       REAL(wp)    ::  flux_d !<
+       REAL(wp)    ::  flux_l !<
+       REAL(wp)    ::  flux_n !<
+       REAL(wp)    ::  flux_r !<
+       REAL(wp)    ::  flux_s !<
+       REAL(wp)    ::  flux_t !<
+       REAL(wp)    ::  fd_1   !<
+       REAL(wp)    ::  fl_1   !<
+       REAL(wp)    ::  fn_1   !<
+       REAL(wp)    ::  fr_1   !<
+       REAL(wp)    ::  fs_1   !<
+       REAL(wp)    ::  ft_1   !<
+       REAL(wp)    ::  phi_d  !<
+       REAL(wp)    ::  phi_l  !<
+       REAL(wp)    ::  phi_n  !<
+       REAL(wp)    ::  phi_r  !<
+       REAL(wp)    ::  phi_s  !<
+       REAL(wp)    ::  phi_t  !<
+       REAL(wp)    ::  rd     !<
+       REAL(wp)    ::  rl     !<
+       REAL(wp)    ::  rn     !<
+       REAL(wp)    ::  rr     !<
+       REAL(wp)    ::  rs     !<
+       REAL(wp)    ::  rt     !<
+       REAL(wp)    ::  u_comp !<
+       REAL(wp)    ::  v_comp !<
+
+       REAL(wp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  ::  sk !<
+
+!
+!--    Computation of fluxes and tendency terms
+       !$acc kernels present( ddzw, sk, tend, u, v, w, wall_flags_0 )
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+             DO  k = nzb+1, nzt
+
+                ibit2 = IBITS(wall_flags_0(k,j,i-1),2,1)
+                ibit1 = IBITS(wall_flags_0(k,j,i-1),1,1)
+                ibit0 = IBITS(wall_flags_0(k,j,i-1),0,1)
+
+                u_comp              = u(k,j,i) - u_gtrans
+                flux_l              = u_comp * (                              &
+                                               ( 37.0_wp * ibit2 * adv_sca_5  &
+                                            +     7.0_wp * ibit1 * adv_sca_3  &
+                                            +              ibit0 * adv_sca_1  &
+                                               ) *                            &
+                                         ( sk(k,j,i)   + sk(k,j,i-1)    )     &
+                                        -      (  8.0_wp * ibit2 * adv_sca_5  &
+                                            +              ibit1 * adv_sca_3  &
+                                               ) *                            &
+                                         ( sk(k,j,i+1) + sk(k,j,i-2)    )     &
+                                        +      (           ibit2 * adv_sca_5  &
+                                               ) *                            &
+                                         ( sk(k,j,i+2) + sk(k,j,i-3)    )     &
+                                               )
+
+                diss_l              = -ABS( u_comp ) * (                      &
+                                               ( 10.0_wp * ibit2 * adv_sca_5  &
+                                            +     3.0_wp * ibit1 * adv_sca_3  &
+                                            +              ibit0 * adv_sca_1  &
+                                               ) *                            &
+                                         ( sk(k,j,i)   - sk(k,j,i-1)    )     &
+                                        -      (  5.0_wp * ibit2 * adv_sca_5  &
+                                            +              ibit1 * adv_sca_3  &
+                                               ) *                            &
+                                         ( sk(k,j,i+1) - sk(k,j,i-2)    )     &
+                                        +      (           ibit2 * adv_sca_5  &
+                                               ) *                            &
+                                         ( sk(k,j,i+2) - sk(k,j,i-3)    )     &
+                                                        )
+
+                ibit2 = IBITS(wall_flags_0(k,j,i),2,1)
+                ibit1 = IBITS(wall_flags_0(k,j,i),1,1)
+                ibit0 = IBITS(wall_flags_0(k,j,i),0,1)
+
+                u_comp    = u(k,j,i+1) - u_gtrans
+                flux_r    = u_comp * (                                        &
+                          ( 37.0_wp * ibit2 * adv_sca_5                       &
+                      +      7.0_wp * ibit1 * adv_sca_3                       &
+                      +               ibit0 * adv_sca_1                       &
+                          ) *                                                 &
+                             ( sk(k,j,i+1) + sk(k,j,i)   )                    &
+                   -      (  8.0_wp * ibit2 * adv_sca_5                       &
+                       +              ibit1 * adv_sca_3                       &
+                          ) *                                                 &
+                             ( sk(k,j,i+2) + sk(k,j,i-1) )                    &
+                   +      (           ibit2 * adv_sca_5                       &
+                          ) *                                                 &
+                             ( sk(k,j,i+3) + sk(k,j,i-2) )                    &
+                                     )
+
+                diss_r    = -ABS( u_comp ) * (                                &
+                          ( 10.0_wp * ibit2 * adv_sca_5                       &
+                       +     3.0_wp * ibit1 * adv_sca_3                       &
+                       +              ibit0 * adv_sca_1                       &
+                          ) *                                                 &
+                             ( sk(k,j,i+1) - sk(k,j,i)   )                    &
+                   -      (  5.0_wp * ibit2 * adv_sca_5                       &
+                       +              ibit1 * adv_sca_3                       &
+                          ) *                                                 &
+                             ( sk(k,j,i+2) - sk(k,j,i-1) )                    &
+                   +      (           ibit2 * adv_sca_5                       &
+                          ) *                                                 &
+                             ( sk(k,j,i+3) - sk(k,j,i-2) )                    &
+                                             )
+
+                ibit5 = IBITS(wall_flags_0(k,j-1,i),5,1)
+                ibit4 = IBITS(wall_flags_0(k,j-1,i),4,1)
+                ibit3 = IBITS(wall_flags_0(k,j-1,i),3,1)
+
+                v_comp    = v(k,j,i) - v_gtrans
+                flux_s    = v_comp * (                                        &
+                          ( 37.0_wp * ibit5 * adv_sca_5                       &
+                       +     7.0_wp * ibit4 * adv_sca_3                       &
+                       +              ibit3 * adv_sca_1                       &
+                          ) *                                                 &
+                             ( sk(k,j,i)  + sk(k,j-1,i)     )                 &
+                    -     (  8.0_wp * ibit5 * adv_sca_5                       &
+                       +              ibit4 * adv_sca_3                       &
+                          ) *                                                 &
+                             ( sk(k,j+1,i) + sk(k,j-2,i)    )                 &
+                   +      (           ibit5 * adv_sca_5                       &
+                          ) *                                                 &
+                             ( sk(k,j+2,i) + sk(k,j-3,i)    )                 &
+                                     )
+
+                diss_s    = -ABS( v_comp ) * (                                &
+                          ( 10.0_wp * ibit5 * adv_sca_5                       &
+                       +     3.0_wp * ibit4 * adv_sca_3                       &
+                       +              ibit3 * adv_sca_1                       &
+                          ) *                                                 &
+                             ( sk(k,j,i)   - sk(k,j-1,i)  )                   &
+                   -      (  5.0_wp * ibit5 * adv_sca_5                       &
+                       +              ibit4 * adv_sca_3                       &
+                          ) *                                                 &
+                             ( sk(k,j+1,i) - sk(k,j-2,i)  )                   &
+                   +      (           ibit5 * adv_sca_5                       &
+                          ) *                                                 &
+                             ( sk(k,j+2,i) - sk(k,j-3,i)  )                   &
+                                             )
+
+                ibit5 = IBITS(wall_flags_0(k,j,i),5,1)
+                ibit4 = IBITS(wall_flags_0(k,j,i),4,1)
+                ibit3 = IBITS(wall_flags_0(k,j,i),3,1)
+
+                v_comp    = v(k,j+1,i) - v_gtrans
+                flux_n    = v_comp * (                                        &
+                          ( 37.0_wp * ibit5 * adv_sca_5                       &
+                       +     7.0_wp * ibit4 * adv_sca_3                       &
+                       +              ibit3 * adv_sca_1                       &
+                          ) *                                                 &
+                             ( sk(k,j+1,i) + sk(k,j,i)   )                    &
+                   -      (  8.0_wp * ibit5 * adv_sca_5                       &
+                       +              ibit4 * adv_sca_3                       &
+                          ) *                                                 &
+                             ( sk(k,j+2,i) + sk(k,j-1,i) )                    &
+                   +      (           ibit5 * adv_sca_5                       &
+                          ) *                                                 &
+                             ( sk(k,j+3,i) + sk(k,j-2,i) )                    &
+                                     )
+
+                diss_n    = -ABS( v_comp ) * (                                &
+                          ( 10.0_wp * ibit5 * adv_sca_5                       &
+                       +     3.0_wp * ibit4 * adv_sca_3                       &
+                       +              ibit3 * adv_sca_1                       &
+                          ) *                                                 &
+                             ( sk(k,j+1,i) - sk(k,j,i)    )                   &
+                   -      (  5.0_wp * ibit5 * adv_sca_5                       &
+                       +              ibit4 * adv_sca_3                       &
+                          ) *                                                 &
+                             ( sk(k,j+2,i) - sk(k,j-1,i)  )                   &
+                   +      (           ibit5 * adv_sca_5                       &
+                          ) *                                                 &
+                             ( sk(k,j+3,i) - sk(k,j-2,i)  )                   &
+                                             )
+
+!
+!--             indizes k_m, k_mm, ... should be known at these point
+                ibit8 = IBITS(wall_flags_0(k-1,j,i),8,1)
+                ibit7 = IBITS(wall_flags_0(k-1,j,i),7,1)
+                ibit6 = IBITS(wall_flags_0(k-1,j,i),6,1)
+
+                k_pp  = k + 2 * ibit8
+                k_mm  = k - 2 * ( ibit7 + ibit8 )
+                k_mmm = k - 3 * ibit8
+
+                flux_d    = w(k-1,j,i) * (                                    &
+                           ( 37.0_wp * ibit8 * adv_sca_5                      &
+                        +     7.0_wp * ibit7 * adv_sca_3                      &
+                        +              ibit6 * adv_sca_1                      &
+                           ) *                                                &
+                                   ( sk(k,j,i)    + sk(k-1,j,i)  )            &
+                    -      (  8.0_wp * ibit8 * adv_sca_5                      &
+                          +            ibit7 * adv_sca_3                      &
+                           ) *                                                &
+                                   ( sk(k+1,j,i) + sk(k_mm,j,i)  )            &
+                    +      (           ibit8 * adv_sca_5                      &
+                           ) *     ( sk(k_pp,j,i)+ sk(k_mmm,j,i) )            &
+                                         )
+
+                diss_d    = -ABS( w(k-1,j,i) ) * (                            &
+                           ( 10.0_wp * ibit8 * adv_sca_5                      &
+                        +     3.0_wp * ibit7 * adv_sca_3                      &
+                        +              ibit6 * adv_sca_1                      &
+                           ) *                                                &
+                                   ( sk(k,j,i)    - sk(k-1,j,i)   )           &
+                    -      (  5.0_wp * ibit8 * adv_sca_5                      &
+                        +              ibit7 * adv_sca_3                      &
+                           ) *                                                &
+                                   ( sk(k+1,j,i)  - sk(k_mm,j,i)  )           &
+                    +      (           ibit8 * adv_sca_5                      &
+                           ) *                                                &
+                                   ( sk(k_pp,j,i) - sk(k_mmm,j,i) )           &
+                                                 )
+
+                ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
+                ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
+                ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
+
+                k_ppp = k + 3 * ibit8
+                k_pp  = k + 2 * ( 1 - ibit6  )
+                k_mm  = k - 2 * ibit8
+
+                flux_t    = w(k,j,i) * (                                      &
+                           ( 37.0_wp * ibit8 * adv_sca_5                      &
+                        +     7.0_wp * ibit7 * adv_sca_3                      &
+                        +              ibit6 * adv_sca_1                      &
+                           ) *                                                &
+                                   ( sk(k+1,j,i)  + sk(k,j,i)    )            &
+                    -      (  8.0_wp * ibit8 * adv_sca_5                      &
+                        +              ibit7 * adv_sca_3                      &
+                           ) *                                                &
+                                   ( sk(k_pp,j,i) + sk(k-1,j,i)  )            &
+                    +      (           ibit8 * adv_sca_5                      &
+                           ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )            &
+                                       )
+
+                diss_t    = -ABS( w(k,j,i) ) * (                              &
+                           ( 10.0_wp * ibit8 * adv_sca_5                      &
+                        +     3.0_wp * ibit7 * adv_sca_3                      &
+                        +              ibit6 * adv_sca_1                      &
+                           ) *                                                &
+                                   ( sk(k+1,j,i)   - sk(k,j,i)    )           &
+                    -      (  5.0_wp * ibit8 * adv_sca_5                      &
+                        +              ibit7 * adv_sca_3                      &
+                           ) *                                                &
+                                   ( sk(k_pp,j,i)  - sk(k-1,j,i)  )           &
+                    +      (           ibit8 * adv_sca_5                      &
+                           ) *                                                &
+                                   ( sk(k_ppp,j,i) - sk(k_mm,j,i) )           &
+                                         )
+!
+!--             Apply monotonic adjustment.
+                IF ( monotonic_adjustment )  THEN
+!
+!--                At first, calculate first order fluxes.
+                   u_comp = u(k,j,i) - u_gtrans
+                   fl_1   =  ( u_comp   * ( sk(k,j,i) + sk(k,j,i-1) )         &
+                         -ABS( u_comp ) * ( sk(k,j,i) - sk(k,j,i-1) )         &
+                             ) * adv_sca_1 
+
+                   u_comp = u(k,j,i+1) - u_gtrans
+                   fr_1   =  ( u_comp   * ( sk(k,j,i+1) + sk(k,j,i) )         &
+                         -ABS( u_comp ) * ( sk(k,j,i+1) - sk(k,j,i) )         &
+                             ) * adv_sca_1 
+
+                   v_comp = v(k,j,i) - v_gtrans
+                   fs_1   =  ( v_comp   * ( sk(k,j,i) + sk(k,j-1,i) )         &
+                         -ABS( v_comp ) * ( sk(k,j,i) - sk(k,j-1,i) )         &
+                             ) * adv_sca_1 
+
+                   v_comp = v(k,j+1,i) - v_gtrans
+                   fn_1   =  ( v_comp   * ( sk(k,j+1,i) + sk(k,j,i) )         &
+                         -ABS( v_comp ) * ( sk(k,j+1,i) - sk(k,j,i) )         &
+                             ) * adv_sca_1 
+
+                   fd_1   = (  w(k-1,j,i)   * ( sk(k,j,i) + sk(k-1,j,i) )     &
+                        -ABS( w(k-1,j,i) ) * ( sk(k,j,i) - sk(k-1,j,i) )      &
+                            ) * adv_sca_1 
+
+                   ft_1   = (  w(k,j,i)   * ( sk(k+1,j,i) + sk(k,j,i) )       &
+                        -ABS( w(k,j,i) ) * ( sk(k+1,j,i) - sk(k,j,i) )        &
+                            ) * adv_sca_1 
+!
+!--                Calculate ratio of upwind gradients. Note, Min/Max is just
+!--                to avoid if statements.
+                   rl     = ( MAX( 0.0_wp, u(k,j,i) - u_gtrans ) *            & 
+                               ABS( ( sk(k,j,i-1) - sk(k,j,i-2)            ) /&
+                                    ( sk(k,j,i)   - sk(k,j,i-1) + 1E-20_wp )  &
+                                  ) +                                         & 
+                              MIN( 0.0_wp, u(k,j,i) - u_gtrans ) *            &
+                               ABS( ( sk(k,j,i)   - sk(k,j,i+1)            ) /&
+                                    ( sk(k,j,i-1) - sk(k,j,i)   + 1E-20_wp )  &
+                                  )                                           &
+                            ) / ABS( u(k,j,i) - u_gtrans + 1E-20_wp )
+
+                   rr     = ( MAX( 0.0_wp, u(k,j,i+1) - u_gtrans ) *          & 
+                               ABS( ( sk(k,j,i)   - sk(k,j,i-1)            ) /&
+                                    ( sk(k,j,i+1) - sk(k,j,i)   + 1E-20_wp )  &
+                                  ) +                                         & 
+                              MIN( 0.0_wp, u(k,j,i+1) - u_gtrans ) *          &
+                               ABS( ( sk(k,j,i+1) - sk(k,j,i+2)            ) /&
+                                    ( sk(k,j,i)   - sk(k,j,i+1) + 1E-20_wp )  &
+                                  )                                           &
+                            ) / ABS( u(k,j,i+1) - u_gtrans + 1E-20_wp )
+
+                   rs     = ( MAX( 0.0_wp, v(k,j,i) - v_gtrans ) *            & 
+                               ABS( ( sk(k,j-1,i) - sk(k,j-2,i)            ) /&
+                                    ( sk(k,j,i)   - sk(k,j-1,i) + 1E-20_wp )  &
+                                  ) +                                         & 
+                              MIN( 0.0_wp, v(k,j,i) - v_gtrans ) *            &
+                               ABS( ( sk(k,j,i)   - sk(k,j+1,i)            ) /&
+                                    ( sk(k,j-1,i) - sk(k,j,i)   + 1E-20_wp )  &
+                                  )                                           &
+                            ) / ABS( v(k,j,i) - v_gtrans + 1E-20_wp )
+
+                   rn     = ( MAX( 0.0_wp, v(k,j+1,i) - v_gtrans ) *          & 
+                               ABS( ( sk(k,j,i)   - sk(k,j-1,i)            ) /&
+                                    ( sk(k,j+1,i) - sk(k,j,i)   + 1E-20_wp )  &
+                                  ) +                                         & 
+                              MIN( 0.0_wp, v(k,j+1,i) - v_gtrans ) *          &
+                               ABS( ( sk(k,j+1,i) - sk(k,j+2,i)            ) /&
+                                    ( sk(k,j,i)   - sk(k,j+1,i) + 1E-20_wp )  &
+                                  )                                           &
+                            ) / ABS( v(k,j+1,i) - v_gtrans + 1E-20_wp )     
+!   
+!--                Reuse k_mm and compute k_mmm for the vertical gradient ratios. 
+!--                Note, for vertical advection below the third grid point above 
+!--                surface ( or below the model top) rd and rt are set to 0, i.e. 
+!--                use of first order scheme is enforced.
+                   k_mmm  = k - 3 * ibit8
+
+                   rd     = ( MAX( 0.0_wp, w(k-1,j,i) ) *                     & 
+                            ABS( ( sk(k_mm,j,i) - sk(k_mmm,j,i)           ) / &
+                                 ( sk(k-1,j,i)  - sk(k_mm,j,i) + 1E-20_wp )   &
+                               ) +                                            & 
+                              MIN( 0.0_wp, w(k-1,j,i) ) *                     &
+                            ABS( ( sk(k-1,j,i) - sk(k,j,i)            ) /     &
+                                 ( sk(k_mm,j,i) - sk(k-1,j,i)   + 1E-20_wp )  &
+                               )                                              &
+                            ) * ibit8 / ABS( w(k-1,j,i) + 1E-20_wp ) 
+ 
+                   rt     = ( MAX( 0.0_wp, w(k,j,i) ) *                       & 
+                            ABS( ( sk(k,j,i)   - sk(k-1,j,i)            ) /   &
+                                 ( sk(k+1,j,i) - sk(k,j,i)   + 1E-20_wp )     &
+                               ) +                                            & 
+                              MIN( 0.0_wp, w(k,j,i) ) *                       &
+                            ABS( ( sk(k+1,j,i) - sk(k_pp,j,i)           ) /   &
+                                 ( sk(k,j,i)   - sk(k+1,j,i) + 1E-20_wp )     &
+                               )                                              &
+                            ) * ibit8 / ABS( w(k,j,i) + 1E-20_wp )
+!
+!--                Calculate empirical limiter function (van Albada2 limiter).
+                   phi_l = MIN( 1.0_wp, ( 2.0_wp * ABS( rl ) ) /              &
+                                        ( rl**2 + 1.0_wp ) ) 
+                   phi_r = MIN( 1.0_wp, ( 2.0_wp * ABS( rr ) ) /              &
+                                        ( rr**2 + 1.0_wp ) ) 
+                   phi_s = MIN( 1.0_wp, ( 2.0_wp * ABS( rs ) ) /              &
+                                        ( rs**2 + 1.0_wp ) ) 
+                   phi_n = MIN( 1.0_wp, ( 2.0_wp * ABS( rn ) ) /              &
+                                        ( rn**2 + 1.0_wp ) ) 
+                   phi_d = MIN( 1.0_wp, ( 2.0_wp * ABS( rd ) ) /              &
+                                        ( rd**2 + 1.0_wp ) ) 
+                   phi_t = MIN( 1.0_wp, ( 2.0_wp * ABS( rt ) ) /              &
+                                        ( rt**2 + 1.0_wp ) ) 
+!
+!--                Calculate the resulting monotone flux. 
+                   flux_l = fl_1 - phi_l * ( fl_1 - flux_l )
+                   flux_r = fr_1 - phi_r * ( fr_1 - flux_r )
+                   flux_s = fs_1 - phi_s * ( fs_1 - flux_s )
+                   flux_n = fn_1 - phi_n * ( fn_1 - flux_n )
+                   flux_d = fd_1 - phi_d * ( fd_1 - flux_d )
+                   flux_t = ft_1 - phi_t * ( ft_1 - flux_t )
+!
+!--                Moreover, modify dissipation flux according to the limiter. 
+                   diss_l = diss_l * phi_l
+                   diss_r = diss_r * phi_r
+                   diss_s = diss_s * phi_s
+                   diss_n = diss_n * phi_n
+                   diss_d = diss_d * phi_d
+                   diss_t = diss_t * phi_t
+
+                ENDIF
+!
+!--             Calculate the divergence of the velocity field. A respective
+!--             correction is needed to overcome numerical instabilities caused
+!--             by a not sufficient reduction of divergences near topography.
+                div   =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )             &
+                          - u(k,j,i)   * ( IBITS(wall_flags_0(k,j,i-1),0,1)    &
+                                         + IBITS(wall_flags_0(k,j,i-1),1,1)    &
+                                         + IBITS(wall_flags_0(k,j,i-1),2,1)    &
+                                         )                                     &
+                          ) * ddx                                              &
+                        + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )             &
+                          - v(k,j,i)   * ( IBITS(wall_flags_0(k,j-1,i),3,1)    &
+                                         + IBITS(wall_flags_0(k,j-1,i),4,1)    &
+                                         + IBITS(wall_flags_0(k,j-1,i),5,1)    &
+                                         )                                     &
+                          ) * ddy                                              &
+                        + ( w(k,j,i)   * ( ibit6 + ibit7 + ibit8 )             &
+                          - w(k-1,j,i) * ( IBITS(wall_flags_0(k-1,j,i),6,1)    &
+                                         + IBITS(wall_flags_0(k-1,j,i),7,1)    &
+                                         + IBITS(wall_flags_0(k-1,j,i),8,1)    &
+                                         )                                     &      
+                          ) * ddzw(k)
+
+
+                tend(k,j,i) = - (                                             &
+                               ( flux_r + diss_r - flux_l - diss_l ) * ddx    &
+                             + ( flux_n + diss_n - flux_s - diss_s ) * ddy    &
+                             + ( flux_t + diss_t - flux_d - diss_d ) * ddzw(k)&
+                                ) + div * sk(k,j,i)
+
+!++
+!--             Evaluation of statistics
+!                SELECT CASE ( sk_char )
+!
+!                   CASE ( 'pt' )
+!                      sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn)         &
+!                       + ( flux_t + diss_t )                                &
+!                       *   weight_substep(intermediate_timestep_count)
+!                   CASE ( 'sa' )
+!                      sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn)         &
+!                       + ( flux_t + diss_t )                                &
+!                       *   weight_substep(intermediate_timestep_count)
+!                   CASE ( 'q' )
+!                      sums_wsqs_ws_l(k,tn) = sums_wsqs_ws_l(k,tn)           &
+!                      + ( flux_t + diss_t )                                 &
+!                      *   weight_substep(intermediate_timestep_count)
+!                   CASE ( 'qr' )
+!                      sums_wsqrs_ws_l(k,tn) = sums_wsqrs_ws_l(k,tn)         &
+!                      + ( flux_t + diss_t )                                 &
+!                      *   weight_substep(intermediate_timestep_count)
+!                   CASE ( 'nr' )
+!                      sums_wsnrs_ws_l(k,tn) = sums_wsnrs_ws_l(k,tn)         &
+!                      + ( flux_t + diss_t )                                 &
+!                      *   weight_substep(intermediate_timestep_count)
+!
+!                END SELECT
+
+             ENDDO
+         ENDDO
+      ENDDO
+      !$acc end kernels
+
+    END SUBROUTINE advec_s_ws_acc
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Advection of u - Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_u_ws
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE constants,                                                          &
+           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
+
+       USE control_parameters,                                                 &
+           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxlu, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0
+           
+       USE kinds
+       
+       USE statistics,                                                         &
+           ONLY:  hom, sums_us2_ws_l, sums_wsus_ws_l, weight_substep
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  ibit9  !<
+       INTEGER(iwp) ::  ibit10 !<
+       INTEGER(iwp) ::  ibit11 !<
+       INTEGER(iwp) ::  ibit12 !<
+       INTEGER(iwp) ::  ibit13 !<
+       INTEGER(iwp) ::  ibit14 !<
+       INTEGER(iwp) ::  ibit15 !<
+       INTEGER(iwp) ::  ibit16 !<
+       INTEGER(iwp) ::  ibit17 !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  k      !<
+       INTEGER(iwp) ::  k_mm   !<
+       INTEGER(iwp) ::  k_pp   !<
+       INTEGER(iwp) ::  k_ppp  !<
+       INTEGER(iwp) ::  tn = 0 !<
+       
+       REAL(wp)    ::  diss_d !<
+       REAL(wp)    ::  div    !<
+       REAL(wp)    ::  flux_d !<
+       REAL(wp)    ::  gu     !<
+       REAL(wp)    ::  gv     !<
+       REAL(wp)    ::  v_comp !<
+       REAL(wp)    ::  w_comp !<
+       
+       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local_u !<
+       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local_u !<
+       
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_u !<
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local_u !<
+       
+       REAL(wp), DIMENSION(nzb:nzt) ::  diss_n !<
+       REAL(wp), DIMENSION(nzb:nzt) ::  diss_r !<
+       REAL(wp), DIMENSION(nzb:nzt) ::  diss_t !<
+       REAL(wp), DIMENSION(nzb:nzt) ::  flux_n !<
+       REAL(wp), DIMENSION(nzb:nzt) ::  flux_r !<
+       REAL(wp), DIMENSION(nzb:nzt) ::  flux_t !<
+       REAL(wp), DIMENSION(nzb:nzt) ::  u_comp !<
+ 
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+
+!
+!--    Compute the fluxes for the whole left boundary of the processor domain.
+       i = nxlu
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzb_max
+
+             ibit11 = IBITS(wall_flags_0(k,j,i-1),11,1)
+             ibit10 = IBITS(wall_flags_0(k,j,i-1),10,1)
+             ibit9  = IBITS(wall_flags_0(k,j,i-1),9,1)
+
+             u_comp(k)                = u(k,j,i) + u(k,j,i-1) - gu
+             swap_flux_x_local_u(k,j) = u_comp(k) * (                          &
+                                       ( 37.0_wp * ibit11 * adv_mom_5             &
+                                    +     7.0_wp * ibit10 * adv_mom_3             &
+                                    +              ibit9  * adv_mom_1             &
+                                       ) *                                     &
+                                     ( u(k,j,i)   + u(k,j,i-1) )               &
+                                -      (  8.0_wp * ibit11 * adv_mom_5             &
+                                    +              ibit10 * adv_mom_3             &
+                                       ) *                                     &
+                                     ( u(k,j,i+1) + u(k,j,i-2) )               &
+                                +      (           ibit11 * adv_mom_5             &
+                                       ) *                                     &
+                                     ( u(k,j,i+2) + u(k,j,i-3) )               &
+                                                   )
+
+              swap_diss_x_local_u(k,j) = - ABS( u_comp(k) ) * (                &
+                                       ( 10.0_wp * ibit11 * adv_mom_5             &
+                                    +     3.0_wp * ibit10 * adv_mom_3             &
+                                    +              ibit9  * adv_mom_1             &
+                                       ) *                                     &
+                                     ( u(k,j,i)   - u(k,j,i-1) )               &
+                                -      (  5.0_wp * ibit11 * adv_mom_5             &
+                                    +              ibit10 * adv_mom_3             &
+                                       ) *                                     &
+                                     ( u(k,j,i+1) - u(k,j,i-2) )               &
+                                +      (           ibit11 * adv_mom_5             &
+                                       ) *                                     &
+                                     ( u(k,j,i+2) - u(k,j,i-3) )               &
+                                                             )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             u_comp(k)         = u(k,j,i) + u(k,j,i-1) - gu
+             swap_flux_x_local_u(k,j) = u_comp(k) * (                          &
+                             37.0_wp * ( u(k,j,i) + u(k,j,i-1)   )                &
+                           -  8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) )                &
+                           +           ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_5
+             swap_diss_x_local_u(k,j) = - ABS(u_comp(k)) * (                   &
+                             10.0_wp * ( u(k,j,i) - u(k,j,i-1)   )                &
+                           -  5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) )                &
+                           +           ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_5
+
+          ENDDO
+       ENDDO
+
+       DO i = nxlu, nxr
+!       
+!--       The following loop computes the fluxes for the south boundary points
+          j = nys
+          DO  k = nzb+1, nzb_max
+
+             ibit14 = IBITS(wall_flags_0(k,j-1,i),14,1)
+             ibit13 = IBITS(wall_flags_0(k,j-1,i),13,1)
+             ibit12 = IBITS(wall_flags_0(k,j-1,i),12,1)
+
+             v_comp                 = v(k,j,i) + v(k,j,i-1) - gv
+             swap_flux_y_local_u(k) = v_comp * (                              &
+                                   ( 37.0_wp * ibit14 * adv_mom_5                &
+                                +     7.0_wp * ibit13 * adv_mom_3                &
+                                +              ibit12 * adv_mom_1                &
+                                   ) *                                        &
+                                     ( u(k,j,i)   + u(k,j-1,i) )              &
+                            -      (  8.0_wp * ibit14 * adv_mom_5                &
+                            +                  ibit13 * adv_mom_3                    &
+                                   ) *                                        &
+                                     ( u(k,j+1,i) + u(k,j-2,i) )              &
+                        +      (               ibit14 * adv_mom_5                    &
+                               ) *                                            &
+                                     ( u(k,j+2,i) + u(k,j-3,i) )              &
+                                               )
+
+             swap_diss_y_local_u(k) = - ABS ( v_comp ) * (                    &
+                                   ( 10.0_wp * ibit14 * adv_mom_5                &
+                                +     3.0_wp * ibit13 * adv_mom_3                &
+                                +              ibit12 * adv_mom_1                &
+                                   ) *                                        &
+                                     ( u(k,j,i)   - u(k,j-1,i) )              &
+                            -      (  5.0_wp * ibit14 * adv_mom_5                &
+                                +              ibit13 * adv_mom_3                &
+                                   ) *                                        &
+                                     ( u(k,j+1,i) - u(k,j-2,i) )              &
+                            +      (           ibit14 * adv_mom_5                &
+                                   ) *                                        &
+                                     ( u(k,j+2,i) - u(k,j-3,i) )              &
+                                                         )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             v_comp                 = v(k,j,i) + v(k,j,i-1) - gv
+             swap_flux_y_local_u(k) = v_comp * (                              &
+                           37.0_wp * ( u(k,j,i) + u(k,j-1,i)   )                 &
+                         -  8.0_wp * ( u(k,j+1,i) + u(k,j-2,i) )                 &
+                         +           ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5
+             swap_diss_y_local_u(k) = - ABS(v_comp) * (                       &
+                           10.0_wp * ( u(k,j,i) - u(k,j-1,i)   )                 &
+                         -  5.0_wp * ( u(k,j+1,i) - u(k,j-2,i) )                 &
+                         +           ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_5
+
+          ENDDO
+!
+!--       Computation of interior fluxes and tendency terms
+          DO  j = nys, nyn
+
+             flux_t(0) = 0.0_wp
+             diss_t(0) = 0.0_wp
+             flux_d    = 0.0_wp
+             diss_d    = 0.0_wp
+
+             DO  k = nzb+1, nzb_max
+
+                ibit11 = IBITS(wall_flags_0(k,j,i),11,1)
+                ibit10 = IBITS(wall_flags_0(k,j,i),10,1)
+                ibit9  = IBITS(wall_flags_0(k,j,i),9,1)
+
+                u_comp(k) = u(k,j,i+1) + u(k,j,i)
+                flux_r(k) = ( u_comp(k) - gu ) * (                           &
+                          ( 37.0_wp * ibit11 * adv_mom_5                        &
+                       +     7.0_wp * ibit10 * adv_mom_3                        &
+                       +              ibit9  * adv_mom_1                        &
+                          ) *                                                &
+                                 ( u(k,j,i+1) + u(k,j,i)   )                 &
+                   -      (  8.0_wp * ibit11 * adv_mom_5                        &
+                       +              ibit10 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( u(k,j,i+2) + u(k,j,i-1) )                 &
+                   +      (           ibit11 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( u(k,j,i+3) + u(k,j,i-2) )                 &
+                                                 )
+
+                diss_r(k) = - ABS( u_comp(k) - gu ) * (                      &
+                          ( 10.0_wp * ibit11 * adv_mom_5                        &
+                       +     3.0_wp * ibit10 * adv_mom_3                        & 
+                       +              ibit9  * adv_mom_1                        &
+                          ) *                                                &
+                                 ( u(k,j,i+1) - u(k,j,i)  )                  &
+                   -      (  5.0_wp * ibit11 * adv_mom_5                        &
+                       +              ibit10 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( u(k,j,i+2) - u(k,j,i-1) )                 &
+                   +      (           ibit11 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( u(k,j,i+3) - u(k,j,i-2) )                 &
+                                                     )
+
+                ibit14 = IBITS(wall_flags_0(k,j,i),14,1)
+                ibit13 = IBITS(wall_flags_0(k,j,i),13,1)
+                ibit12 = IBITS(wall_flags_0(k,j,i),12,1)
+
+                v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
+                flux_n(k) = v_comp * (                                       &
+                          ( 37.0_wp * ibit14 * adv_mom_5                        &
+                       +     7.0_wp * ibit13 * adv_mom_3                        &
+                       +              ibit12 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( u(k,j+1,i) + u(k,j,i)   )                 &
+                   -      (  8.0_wp * ibit14 * adv_mom_5                        &
+                       +              ibit13 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( u(k,j+2,i) + u(k,j-1,i) )                 &
+                   +      (           ibit14 * adv_mom_5                        & 
+                          ) *                                                &
+                                 ( u(k,j+3,i) + u(k,j-2,i) )                 &
+                                                 )
+
+                diss_n(k) = - ABS ( v_comp ) * (                             &
+                          ( 10.0_wp * ibit14 * adv_mom_5                        &
+                       +     3.0_wp * ibit13 * adv_mom_3                        &
+                       +              ibit12 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( u(k,j+1,i) - u(k,j,i)  )                  &
+                   -      (  5.0_wp * ibit14 * adv_mom_5                        &
+                       +              ibit13 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( u(k,j+2,i) - u(k,j-1,i) )                 &
+                   +      (           ibit14 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( u(k,j+3,i) - u(k,j-2,i) )                 &
+                                                      )
+!
+!--             k index has to be modified near bottom and top, else array
+!--             subscripts will be exceeded.
+                ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
+                ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
+                ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
+
+                k_ppp = k + 3 * ibit17
+                k_pp  = k + 2 * ( 1 - ibit15  )
+                k_mm  = k - 2 * ibit17
+
+                w_comp    = w(k,j,i) + w(k,j,i-1)
+                flux_t(k) = w_comp  * (                                      &
+                          ( 37.0_wp * ibit17 * adv_mom_5                        &
+                       +     7.0_wp * ibit16 * adv_mom_3                        &
+                       +              ibit15 * adv_mom_1                        & 
+                          ) *                                                &
+                             ( u(k+1,j,i)  + u(k,j,i)     )                  &
+                   -      (  8.0_wp * ibit17 * adv_mom_5                        &
+                       +              ibit16 * adv_mom_3                        &
+                          ) *                                                &
+                             ( u(k_pp,j,i) + u(k-1,j,i)   )                  &
+                   +      (           ibit17 * adv_mom_5                        &
+                          ) *                                                &
+                             ( u(k_ppp,j,i) + u(k_mm,j,i) )                  &
+                                      )
+
+                diss_t(k) = - ABS( w_comp ) * (                              &
+                          ( 10.0_wp * ibit17 * adv_mom_5                        &
+                       +     3.0_wp * ibit16 * adv_mom_3                        &
+                       +              ibit15 * adv_mom_1                        &
+                          ) *                                                &
+                             ( u(k+1,j,i)   - u(k,j,i)    )                  &
+                   -      (  5.0_wp * ibit17 * adv_mom_5                        &
+                       +              ibit16 * adv_mom_3                        &
+                          ) *                                                &
+                             ( u(k_pp,j,i)  - u(k-1,j,i)  )                  &
+                   +      (           ibit17 * adv_mom_5                        &
+                           ) *                                               &
+                             ( u(k_ppp,j,i) - u(k_mm,j,i) )                  &
+                                              )
+!
+!--             Calculate the divergence of the velocity field. A respective
+!--             correction is needed to overcome numerical instabilities caused
+!--             by a not sufficient reduction of divergences near topography.
+                div = ( ( u_comp(k) * ( ibit9 + ibit10 + ibit11 )             &
+                - ( u(k,j,i)   + u(k,j,i-1)   )                               &
+                                    * ( IBITS(wall_flags_0(k,j,i-1),9,1)      &
+                                      + IBITS(wall_flags_0(k,j,i-1),10,1)     &
+                                      + IBITS(wall_flags_0(k,j,i-1),11,1)     &
+                                      )                                       &   
+                  ) * ddx                                                     &
+               +  ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 )            &
+                  - ( v(k,j,i)   + v(k,j,i-1 )  )                             &
+                                    * ( IBITS(wall_flags_0(k,j-1,i),12,1)     &
+                                      + IBITS(wall_flags_0(k,j-1,i),13,1)     &
+                                      + IBITS(wall_flags_0(k,j-1,i),14,1)     &
+                                      )                                       &
+                  ) * ddy                                                     &
+               +  ( w_comp          * ( ibit15 + ibit16 + ibit17 )            &
+                - ( w(k-1,j,i) + w(k-1,j,i-1) )                               &
+                                    * ( IBITS(wall_flags_0(k-1,j,i),15,1)     &
+                                      + IBITS(wall_flags_0(k-1,j,i),16,1)     &
+                                      + IBITS(wall_flags_0(k-1,j,i),17,1)     &
+                                      )                                       &  
+                  ) * ddzw(k)   &
+                ) * 0.5_wp
+
+
+
+                tend(k,j,i) = tend(k,j,i) - (                                  &
+                 ( flux_r(k) + diss_r(k)                                       &
+               -   swap_flux_x_local_u(k,j) - swap_diss_x_local_u(k,j) ) * ddx &
+               + ( flux_n(k) + diss_n(k)                                       &
+               -   swap_flux_y_local_u(k)   - swap_diss_y_local_u(k)   ) * ddy &
+               + ( flux_t(k) + diss_t(k)                                       &
+               -   flux_d    - diss_d                                          &
+                                                                  ) * ddzw(k)  &
+                                           ) + div * u(k,j,i)
+
+                swap_flux_x_local_u(k,j) = flux_r(k)
+                swap_diss_x_local_u(k,j) = diss_r(k)
+                swap_flux_y_local_u(k)   = flux_n(k)
+                swap_diss_y_local_u(k)   = diss_n(k)
+                flux_d                   = flux_t(k)
+                diss_d                   = diss_t(k)
+!
+!--             Statistical Evaluation of u'u'. The factor has to be applied
+!--             for right evaluation when gallilei_trans = .T. .
+                sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                     &
+                              + ( flux_r(k) *                                 &
+                                ( u_comp(k) - 2.0_wp * hom(k,1,1,0) )            &
+                              / ( u_comp(k) - gu + 1.0E-20_wp    )            &
+                              +   diss_r(k) *                                 &
+                                  ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0) )       &
+                              / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) )      &
+                              *   weight_substep(intermediate_timestep_count)
+!
+!--             Statistical Evaluation of w'u'.
+                sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                   &
+                              + ( flux_t(k) + diss_t(k) )                     &
+                              *   weight_substep(intermediate_timestep_count)
+             ENDDO
+
+             DO  k = nzb_max+1, nzt
+
+                u_comp(k) = u(k,j,i+1) + u(k,j,i)
+                flux_r(k) = ( u_comp(k) - gu ) * (                            &
+                         37.0_wp * ( u(k,j,i+1) + u(k,j,i)   )                   &
+                       -  8.0_wp * ( u(k,j,i+2) + u(k,j,i-1) )                   &
+                       +           ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_5
+                diss_r(k) = - ABS( u_comp(k) - gu ) * (                       &
+                         10.0_wp * ( u(k,j,i+1) - u(k,j,i)   )                   &
+                       -  5.0_wp * ( u(k,j,i+2) - u(k,j,i-1) )                   &
+                       +           ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_5
+
+                v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
+                flux_n(k) = v_comp * (                                        &
+                         37.0_wp * ( u(k,j+1,i) + u(k,j,i)   )                   &
+                       -  8.0_wp * ( u(k,j+2,i) + u(k,j-1,i) )                   &
+                       +           ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_5
+                diss_n(k) = - ABS( v_comp ) * (                               &
+                         10.0_wp * ( u(k,j+1,i) - u(k,j,i)   )                   &
+                       -  5.0_wp * ( u(k,j+2,i) - u(k,j-1,i) )                   &
+                       +           ( u(k,j+3,i) - u(k,j-2,i) ) ) * adv_mom_5
+!
+!--             k index has to be modified near bottom and top, else array
+!--             subscripts will be exceeded.
+                ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
+                ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
+                ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
+
+                k_ppp = k + 3 * ibit17
+                k_pp  = k + 2 * ( 1 - ibit15  )
+                k_mm  = k - 2 * ibit17
+
+                w_comp    = w(k,j,i) + w(k,j,i-1)
+                flux_t(k) = w_comp  * (                                      &
+                          ( 37.0_wp * ibit17 * adv_mom_5                        &
+                       +     7.0_wp * ibit16 * adv_mom_3                        &
+                       +              ibit15 * adv_mom_1                        &
+                          ) *                                                &
+                             ( u(k+1,j,i)  + u(k,j,i)     )                  &
+                   -      (  8.0_wp * ibit17 * adv_mom_5                        &
+                       +              ibit16 * adv_mom_3                        &
+                          ) *                                                &
+                             ( u(k_pp,j,i) + u(k-1,j,i)   )                  &
+                   +      (           ibit17 * adv_mom_5                        &
+                          ) *                                                &
+                             ( u(k_ppp,j,i) + u(k_mm,j,i) )                  &
+                                      )
+
+                diss_t(k) = - ABS( w_comp ) * (                              &
+                          ( 10.0_wp * ibit17 * adv_mom_5                        &
+                       +     3.0_wp * ibit16 * adv_mom_3                        &
+                       +              ibit15 * adv_mom_1                        &
+                          ) *                                                &
+                             ( u(k+1,j,i)   - u(k,j,i)    )                  &
+                   -      (  5.0_wp * ibit17 * adv_mom_5                        &
+                       +              ibit16 * adv_mom_3                        &
+                          ) *                                                &
+                             ( u(k_pp,j,i)  - u(k-1,j,i)  )                  &
+                   +      (           ibit17 * adv_mom_5                        &
+                           ) *                                               &
+                             ( u(k_ppp,j,i) - u(k_mm,j,i) )                  &
+                                              )
+!
+!--             Calculate the divergence of the velocity field. A respective
+!--             correction is needed to overcome numerical instabilities caused
+!--             by a not sufficient reduction of divergences near topography.
+                div = ( ( u_comp(k)   - ( u(k,j,i)   + u(k,j,i-1)   ) ) * ddx &
+                     +  ( v_comp + gv - ( v(k,j,i)   + v(k,j,i-1 )  ) ) * ddy &
+                     +  ( w_comp      - ( w(k-1,j,i) + w(k-1,j,i-1) ) )       &
+                                                                    * ddzw(k) &
+                      ) * 0.5_wp
+
+                 tend(k,j,i) = tend(k,j,i) - (                                 &
+                 ( flux_r(k) + diss_r(k)                                       &
+               -   swap_flux_x_local_u(k,j) - swap_diss_x_local_u(k,j) ) * ddx &
+               + ( flux_n(k) + diss_n(k)                                       &
+               -   swap_flux_y_local_u(k)   - swap_diss_y_local_u(k)   ) * ddy &
+               + ( flux_t(k) + diss_t(k)                                       &
+               -   flux_d    - diss_d                                          &
+                                                                  ) * ddzw(k)  &
+                                           ) + div * u(k,j,i)
+
+                 swap_flux_x_local_u(k,j) = flux_r(k)
+                 swap_diss_x_local_u(k,j) = diss_r(k)
+                 swap_flux_y_local_u(k)   = flux_n(k)
+                 swap_diss_y_local_u(k)   = diss_n(k)
+                 flux_d                   = flux_t(k)
+                 diss_d                   = diss_t(k)
+!
+!--              Statistical Evaluation of u'u'. The factor has to be applied
+!--              for right evaluation when gallilei_trans = .T. .
+                 sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                    &
+                              + ( flux_r(k) *                                 &
+                                ( u_comp(k) - 2.0_wp * hom(k,1,1,0) )            &
+                              / ( u_comp(k) - gu + 1.0E-20_wp   )             &
+                              +   diss_r(k) *                                 &
+                                  ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0) )       &
+                              / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) )      &
+                              *   weight_substep(intermediate_timestep_count)
+!
+!--              Statistical Evaluation of w'u'.
+                 sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                  &
+                              + ( flux_t(k) + diss_t(k) )                     &
+                              *   weight_substep(intermediate_timestep_count)
+       ENDDO
+          ENDDO
+       ENDDO
+       sums_us2_ws_l(nzb,tn) = sums_us2_ws_l(nzb+1,tn)
+
+
+    END SUBROUTINE advec_u_ws
+    
+    
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Advection of u - Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_u_ws_acc
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE constants,                                                          &
+           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
+
+       USE control_parameters,                                                 &
+           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
+                  nzb_max, nzt, wall_flags_0
+           
+       USE kinds
+       
+!        USE statistics,                                                       &
+!            ONLY:  hom, sums_us2_ws_l, sums_wsus_ws_l, weight_substep
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  ibit9  !<
+       INTEGER(iwp) ::  ibit10 !<
+       INTEGER(iwp) ::  ibit11 !<
+       INTEGER(iwp) ::  ibit12 !<
+       INTEGER(iwp) ::  ibit13 !<
+       INTEGER(iwp) ::  ibit14 !<
+       INTEGER(iwp) ::  ibit15 !<
+       INTEGER(iwp) ::  ibit16 !<
+       INTEGER(iwp) ::  ibit17 !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  k      !<
+       INTEGER(iwp) ::  k_mmm  !<
+       INTEGER(iwp) ::  k_mm   !<
+       INTEGER(iwp) ::  k_pp   !<
+       INTEGER(iwp) ::  k_ppp  !<
+       INTEGER(iwp) ::  tn = 0 !<
+
+       REAL(wp)    ::  diss_d   !<
+       REAL(wp)    ::  diss_l   !<
+       REAL(wp)    ::  diss_n   !<
+       REAL(wp)    ::  diss_r   !<
+       REAL(wp)    ::  diss_s   !<
+       REAL(wp)    ::  diss_t   !<
+       REAL(wp)    ::  div      !<
+       REAL(wp)    ::  flux_d   !<
+       REAL(wp)    ::  flux_l   !<
+       REAL(wp)    ::  flux_n   !<
+       REAL(wp)    ::  flux_r   !<
+       REAL(wp)    ::  flux_s   !<
+       REAL(wp)    ::  flux_t   !<
+       REAL(wp)    ::  gu       !<
+       REAL(wp)    ::  gv       !<
+       REAL(wp)    ::  u_comp   !<
+       REAL(wp)    ::  u_comp_l !<
+       REAL(wp)    ::  v_comp   !<
+       REAL(wp)    ::  v_comp_s !<
+       REAL(wp)    ::  w_comp   !<
+
+
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+
+!
+!--    Computation of fluxes and tendency terms
+       !$acc  kernels present( ddzw, tend, u, v, w, wall_flags_0 )
+       DO i = i_left, i_right
+          DO  j = j_south, j_north
+             DO  k = nzb+1, nzt
+
+                ibit11 = IBITS(wall_flags_0(k,j,i-1),11,1)
+                ibit10 = IBITS(wall_flags_0(k,j,i-1),10,1)
+                ibit9  = IBITS(wall_flags_0(k,j,i-1),9,1)
+
+                u_comp_l           = u(k,j,i) + u(k,j,i-1) - gu
+                flux_l             = u_comp_l * (                          &
+                                    ( 37.0_wp * ibit11 * adv_mom_5             &
+                                 +     7.0_wp * ibit10 * adv_mom_3             &
+                                 +              ibit9  * adv_mom_1             &
+                                    ) *                                     &
+                                  ( u(k,j,i)   + u(k,j,i-1) )               &
+                             -      (  8.0_wp * ibit11 * adv_mom_5             &
+                                 +              ibit10 * adv_mom_3             &
+                                    ) *                                     &
+                                  ( u(k,j,i+1) + u(k,j,i-2) )               &
+                             +      (           ibit11 * adv_mom_5             &
+                                    ) *                                     &
+                                  ( u(k,j,i+2) + u(k,j,i-3) )               &
+                                                )
+
+                diss_l             = - ABS( u_comp_l ) * (                &
+                                   ( 10.0_wp * ibit11 * adv_mom_5             &
+                                +     3.0_wp * ibit10 * adv_mom_3             &
+                                +              ibit9  * adv_mom_1             &
+                                   ) *                                     &
+                                 ( u(k,j,i)   - u(k,j,i-1) )               &
+                            -      (  5.0_wp * ibit11 * adv_mom_5             &
+                                +              ibit10 * adv_mom_3             &
+                                   ) *                                     &
+                                 ( u(k,j,i+1) - u(k,j,i-2) )               &
+                            +      (           ibit11 * adv_mom_5             &
+                                   ) *                                     &
+                                 ( u(k,j,i+2) - u(k,j,i-3) )               &
+                                                         )
+
+                ibit11 = IBITS(wall_flags_0(k,j,i),11,1)
+                ibit10 = IBITS(wall_flags_0(k,j,i),10,1)
+                ibit9  = IBITS(wall_flags_0(k,j,i),9,1)
+
+                u_comp    = u(k,j,i+1) + u(k,j,i)
+                flux_r    = ( u_comp   - gu ) * (                           &
+                          ( 37.0_wp * ibit11 * adv_mom_5                        &
+                       +     7.0_wp * ibit10 * adv_mom_3                        &
+                       +              ibit9  * adv_mom_1                        &
+                          ) *                                                &
+                                 ( u(k,j,i+1) + u(k,j,i)   )                 &
+                   -      (  8.0_wp * ibit11 * adv_mom_5                        &
+                       +              ibit10 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( u(k,j,i+2) + u(k,j,i-1) )                 &
+                   +      (           ibit11 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( u(k,j,i+3) + u(k,j,i-2) )                 &
+                                                 )
+
+                diss_r    = - ABS( u_comp    - gu ) * (                      &
+                          ( 10.0_wp * ibit11 * adv_mom_5                        &
+                       +     3.0_wp * ibit10 * adv_mom_3                        &
+                       +              ibit9  * adv_mom_1                        &
+                          ) *                                                &
+                                 ( u(k,j,i+1) - u(k,j,i)  )                  &
+                   -      (  5.0_wp * ibit11 * adv_mom_5                        &
+                       +              ibit10 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( u(k,j,i+2) - u(k,j,i-1) )                 &
+                   +      (           ibit11 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( u(k,j,i+3) - u(k,j,i-2) )                 &
+                                                     )
+
+                ibit14 = IBITS(wall_flags_0(k,j-1,i),14,1)
+                ibit13 = IBITS(wall_flags_0(k,j-1,i),13,1)
+                ibit12 = IBITS(wall_flags_0(k,j-1,i),12,1)
+
+                v_comp_s                 = v(k,j,i) + v(k,j,i-1) - gv
+                flux_s                   = v_comp_s * (                       &
+                                   ( 37.0_wp * ibit14 * adv_mom_5                &
+                                +     7.0_wp * ibit13 * adv_mom_3                &
+                                +              ibit12 * adv_mom_1                &
+                                   ) *                                         &
+                                     ( u(k,j,i)   + u(k,j-1,i) )              &
+                            -      (  8.0_wp * ibit14 * adv_mom_5                &
+                            +                  ibit13 * adv_mom_3                    &
+                                   ) *                                        &
+                                     ( u(k,j+1,i) + u(k,j-2,i) )              &
+                        +      (               ibit14 * adv_mom_5                    &
+                               ) *                                            &
+                                     ( u(k,j+2,i) + u(k,j-3,i) )              &
+                                               )
+
+                diss_s                  = - ABS ( v_comp_s ) * (              &
+                                   ( 10.0_wp * ibit14 * adv_mom_5                &
+                                +     3.0_wp * ibit13 * adv_mom_3                &
+                                +              ibit12 * adv_mom_1                &
+                                   ) *                                        &
+                                     ( u(k,j,i)   - u(k,j-1,i) )              &
+                            -      (  5.0_wp * ibit14 * adv_mom_5                &
+                                +              ibit13 * adv_mom_3                &
+                                   ) *                                        &
+                                     ( u(k,j+1,i) - u(k,j-2,i) )              &
+                            +      (           ibit14 * adv_mom_5                &
+                                   ) *                                        &
+                                     ( u(k,j+2,i) - u(k,j-3,i) )              &
+                                                         )
+
+
+                ibit14 = IBITS(wall_flags_0(k,j,i),14,1)
+                ibit13 = IBITS(wall_flags_0(k,j,i),13,1)
+                ibit12 = IBITS(wall_flags_0(k,j,i),12,1)
+
+                v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
+                flux_n    = v_comp * (                                       &
+                          ( 37.0_wp * ibit14 * adv_mom_5                        &
+                       +     7.0_wp * ibit13 * adv_mom_3                        &
+                       +              ibit12 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( u(k,j+1,i) + u(k,j,i)   )                 &
+                   -      (  8.0_wp * ibit14 * adv_mom_5                        &
+                       +              ibit13 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( u(k,j+2,i) + u(k,j-1,i) )                 &
+                   +      (           ibit14 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( u(k,j+3,i) + u(k,j-2,i) )                 &
+                                                 )
+
+                diss_n    = - ABS ( v_comp ) * (                             &
+                          ( 10.0_wp * ibit14 * adv_mom_5                        &
+                       +     3.0_wp * ibit13 * adv_mom_3                        &
+                       +              ibit12 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( u(k,j+1,i) - u(k,j,i)  )                  &
+                   -      (  5.0_wp * ibit14 * adv_mom_5                        &
+                       +              ibit13 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( u(k,j+2,i) - u(k,j-1,i) )                 &
+                   +      (           ibit14 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( u(k,j+3,i) - u(k,j-2,i) )                 &
+                                                      )
+
+                ibit17 = IBITS(wall_flags_0(k-1,j,i),17,1)
+                ibit16 = IBITS(wall_flags_0(k-1,j,i),16,1)
+                ibit15 = IBITS(wall_flags_0(k-1,j,i),15,1)
+
+                k_pp  = k + 2 * ibit17
+                k_mm  = k - 2 * ( ibit16 + ibit17 )
+                k_mmm = k - 3 * ibit17
+
+                w_comp    = w(k-1,j,i) + w(k-1,j,i-1)
+                flux_d    = w_comp  * (                                      &
+                          ( 37.0_wp * ibit17 * adv_mom_5                        &
+                       +     7.0_wp * ibit16 * adv_mom_3                        &
+                       +              ibit15 * adv_mom_1                        &
+                          ) *                                                &
+                             ( u(k,j,i)    + u(k-1,j,i)   )                  &
+                   -      (  8.0_wp * ibit17 * adv_mom_5                        &
+                       +              ibit16 * adv_mom_3                        &
+                          ) *                                                &
+                             ( u(k+1,j,i) + u(k_mm,j,i)   )                  &
+                   +      (           ibit17 * adv_mom_5                        &
+                          ) *                                                 &
+                             ( u(k_pp,j,i) + u(k_mmm,j,i) )                  &
+                                      )
+
+                diss_d    = - ABS( w_comp ) * (                              &
+                          ( 10.0_wp * ibit17 * adv_mom_5                        &
+                       +     3.0_wp * ibit16 * adv_mom_3                        &
+                       +              ibit15 * adv_mom_1                        &
+                          ) *                                                &
+                             ( u(k,j,i)     - u(k-1,j,i)  )                  &
+                   -      (  5.0_wp * ibit17 * adv_mom_5                        &
+                       +              ibit16 * adv_mom_3                        &
+                          ) *                                                &
+                             ( u(k+1,j,i)  - u(k_mm,j,i)  )                  &
+                   +      (           ibit17 * adv_mom_5                        &
+                           ) *                                               &
+                             ( u(k_pp,j,i) - u(k_mmm,j,i) )                  &
+                                              )
+!
+!--             k index has to be modified near bottom and top, else array
+!--             subscripts will be exceeded.
+                ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
+                ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
+                ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
+
+                k_ppp = k + 3 * ibit17
+                k_pp  = k + 2 * ( 1 - ibit15  )
+                k_mm  = k - 2 * ibit17
+
+                w_comp    = w(k,j,i) + w(k,j,i-1)
+                flux_t    = w_comp  * (                                      &
+                          ( 37.0_wp * ibit17 * adv_mom_5                        &
+                       +     7.0_wp * ibit16 * adv_mom_3                        &
+                       +              ibit15 * adv_mom_1                        &
+                          ) *                                                &
+                             ( u(k+1,j,i)  + u(k,j,i)     )                  &
+                   -      (  8.0_wp * ibit17 * adv_mom_5                        &
+                       +              ibit16 * adv_mom_3                        &
+                          ) *                                                &
+                             ( u(k_pp,j,i) + u(k-1,j,i)   )                  &
+                   +      (           ibit17 * adv_mom_5                        &
+                          ) *                                                &
+                             ( u(k_ppp,j,i) + u(k_mm,j,i) )                  &
+                                      )
+
+                diss_t    = - ABS( w_comp ) * (                              &
+                          ( 10.0_wp * ibit17 * adv_mom_5                        &
+                       +     3.0_wp * ibit16 * adv_mom_3                        &
+                       +              ibit15 * adv_mom_1                        &
+                          ) *                                                &
+                             ( u(k+1,j,i)   - u(k,j,i)    )                  &
+                   -      (  5.0_wp * ibit17 * adv_mom_5                        &
+                       +              ibit16 * adv_mom_3                        &
+                          ) *                                                &
+                             ( u(k_pp,j,i)  - u(k-1,j,i)  )                  &
+                   +      (           ibit17 * adv_mom_5                        &
+                           ) *                                               &
+                             ( u(k_ppp,j,i) - u(k_mm,j,i) )                  &
+                                              )
+!
+!--             Calculate the divergence of the velocity field. A respective
+!--             correction is needed to overcome numerical instabilities caused
+!--             by a not sufficient reduction of divergences near topography.
+                div = ( ( u_comp    * ( ibit9 + ibit10 + ibit11 )             &
+                - ( u(k,j,i)   + u(k,j,i-1)   )                               &
+                                    * ( IBITS(wall_flags_0(k,j,i-1),9,1)      &
+                                      + IBITS(wall_flags_0(k,j,i-1),10,1)     &
+                                      + IBITS(wall_flags_0(k,j,i-1),11,1)     &
+                                      )                                       &   
+                  ) * ddx                                                     &
+               +  ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 )            &
+                  - ( v(k,j,i)   + v(k,j,i-1 )  )                             &
+                                    * ( IBITS(wall_flags_0(k,j-1,i),12,1)     &
+                                      + IBITS(wall_flags_0(k,j-1,i),13,1)     &
+                                      + IBITS(wall_flags_0(k,j-1,i),14,1)     &
+                                      )                                       &
+                  ) * ddy                                                     &
+               +  ( w_comp          * ( ibit15 + ibit16 + ibit17 )            &
+                - ( w(k-1,j,i) + w(k-1,j,i-1) )                               &
+                                    * ( IBITS(wall_flags_0(k-1,j,i),15,1)     &
+                                      + IBITS(wall_flags_0(k-1,j,i),16,1)     &
+                                      + IBITS(wall_flags_0(k-1,j,i),17,1)     &
+                                      )                                       &  
+                  ) * ddzw(k)   &
+                ) * 0.5_wp
+
+
+                tend(k,j,i) = - (                                              &
+                               ( flux_r + diss_r - flux_l - diss_l ) * ddx     &
+                             + ( flux_n + diss_n - flux_s - diss_s ) * ddy     &
+                             + ( flux_t + diss_t - flux_d - diss_d ) * ddzw(k) &
+                                ) + div * u(k,j,i)
+
+!++
+!--             Statistical Evaluation of u'u'. The factor has to be applied
+!--             for right evaluation when gallilei_trans = .T. .
+!                sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                     &
+!                              + ( flux_r    *                                 &
+!                                ( u_comp    - 2.0_wp * hom(k,1,1,0) )            &
+!                              / ( u_comp    - gu + 1.0E-20_wp   )             &
+!                              +   diss_r    *                                 &
+!                                  ABS( u_comp    - 2.0_wp * hom(k,1,1,0) )       &
+!                              / ( ABS( u_comp    - gu ) + 1.0E-20_wp ) )      &
+!                              *   weight_substep(intermediate_timestep_count)
+!
+!--             Statistical Evaluation of w'u'.
+!                sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                   &
+!                              + ( flux_t    + diss_t    )                     &
+!                              *   weight_substep(intermediate_timestep_count)
+             ENDDO
+          ENDDO
+       ENDDO
+       !$acc end kernels
+
+!++
+!       sums_us2_ws_l(nzb,tn) = sums_us2_ws_l(nzb+1,tn)
+
+    END SUBROUTINE advec_u_ws_acc
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Advection of v - Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_v_ws
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE constants,                                                          &
+           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
+
+       USE control_parameters,                                                 &
+           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, wall_flags_0
+
+       USE kinds
+
+       USE statistics,                                                         &
+           ONLY:  hom, sums_vs2_ws_l, sums_wsvs_ws_l, weight_substep
+
+       IMPLICIT NONE
+
+
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  ibit18 !<
+       INTEGER(iwp) ::  ibit19 !<
+       INTEGER(iwp) ::  ibit20 !<
+       INTEGER(iwp) ::  ibit21 !<
+       INTEGER(iwp) ::  ibit22 !<
+       INTEGER(iwp) ::  ibit23 !<
+       INTEGER(iwp) ::  ibit24 !<
+       INTEGER(iwp) ::  ibit25 !<
+       INTEGER(iwp) ::  ibit26 !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  k      !<
+       INTEGER(iwp) ::  k_mm   !<
+       INTEGER(iwp) ::  k_pp   !<
+       INTEGER(iwp) ::  k_ppp  !<
+       INTEGER(iwp) ::  tn = 0 !<
+       
+       REAL(wp)    ::  diss_d !<
+       REAL(wp)    ::  div    !<
+       REAL(wp)    ::  flux_d !<
+       REAL(wp)    ::  gu     !<
+       REAL(wp)    ::  gv     !<
+       REAL(wp)    ::  u_comp !<
+       REAL(wp)    ::  w_comp !<
+       
+       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local_v !<
+       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local_v !<
+       
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_v !<
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local_v !<
+       
+       REAL(wp), DIMENSION(nzb:nzt) ::  diss_n !<
+       REAL(wp), DIMENSION(nzb:nzt) ::  diss_r !<
+       REAL(wp), DIMENSION(nzb:nzt) ::  diss_t !<
+       REAL(wp), DIMENSION(nzb:nzt) ::  flux_n !<
+       REAL(wp), DIMENSION(nzb:nzt) ::  flux_r !<
+       REAL(wp), DIMENSION(nzb:nzt) ::  flux_t !<
+       REAL(wp), DIMENSION(nzb:nzt) ::  v_comp !<
+
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+!
+!--    First compute the whole left boundary of the processor domain
+       i = nxl
+       DO  j = nysv, nyn
+          DO  k = nzb+1, nzb_max
+
+             ibit20 = IBITS(wall_flags_0(k,j,i-1),20,1)
+             ibit19 = IBITS(wall_flags_0(k,j,i-1),19,1)
+             ibit18 = IBITS(wall_flags_0(k,j,i-1),18,1)
+
+             u_comp                   = u(k,j-1,i) + u(k,j,i) - gu
+             swap_flux_x_local_v(k,j) = u_comp * (                             &
+                                      ( 37.0_wp * ibit20 * adv_mom_5              &
+                                   +     7.0_wp * ibit19 * adv_mom_3              &
+                                   +              ibit18 * adv_mom_1              &
+                                      ) *                                      &
+                                     ( v(k,j,i)   + v(k,j,i-1) )               &
+                               -      (  8.0_wp * ibit20 * adv_mom_5              &
+                                   +              ibit19 * adv_mom_3              &
+                                      ) *                                      &
+                                     ( v(k,j,i+1) + v(k,j,i-2) )               &
+                               +      (           ibit20 * adv_mom_5              &
+                                      ) *                                      &
+                                     ( v(k,j,i+2) + v(k,j,i-3) )               &
+                                                 )
+
+              swap_diss_x_local_v(k,j) = - ABS( u_comp ) * (                   &
+                                      ( 10.0_wp * ibit20 * adv_mom_5              &
+                                   +     3.0_wp * ibit19 * adv_mom_3              &
+                                   +              ibit18 * adv_mom_1              &
+                                      ) *                                      &
+                                     ( v(k,j,i)   - v(k,j,i-1) )               &
+                               -      (  5.0_wp * ibit20 * adv_mom_5              &
+                                   +              ibit19 * adv_mom_3              &
+                                      ) *                                      &
+                                     ( v(k,j,i+1) - v(k,j,i-2) )               &
+                               +      (           ibit20 * adv_mom_5              &
+                                      ) *                                      &
+                                     ( v(k,j,i+2) - v(k,j,i-3) )               &
+                                                           )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             u_comp                   = u(k,j-1,i) + u(k,j,i) - gu
+             swap_flux_x_local_v(k,j) = u_comp * (                            &
+                             37.0_wp * ( v(k,j,i) + v(k,j,i-1)   )               &
+                           -  8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) )               &
+                           +           ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5
+             swap_diss_x_local_v(k,j) = - ABS( u_comp ) * (                   &
+                             10.0_wp * ( v(k,j,i) - v(k,j,i-1)   )               &
+                           -  5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) )               &
+                           +           ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5
+
+          ENDDO
+
+       ENDDO
+
+       DO i = nxl, nxr
+
+          j = nysv
+          DO  k = nzb+1, nzb_max
+
+             ibit23 = IBITS(wall_flags_0(k,j-1,i),23,1)
+             ibit22 = IBITS(wall_flags_0(k,j-1,i),22,1)
+             ibit21 = IBITS(wall_flags_0(k,j-1,i),21,1)
+
+             v_comp(k)              = v(k,j,i) + v(k,j-1,i) - gv
+             swap_flux_y_local_v(k) = v_comp(k) * (                           &
+                                   ( 37.0_wp * ibit23 * adv_mom_5                &
+                                +     7.0_wp * ibit22 * adv_mom_3                &
+                                +              ibit21 * adv_mom_1                &
+                                   ) *                                        &
+                                     ( v(k,j,i)   + v(k,j-1,i) )              &
+                            -      (  8.0_wp * ibit23 * adv_mom_5                &
+                                +              ibit22 * adv_mom_3                &
+                                   ) *                                        &
+                                     ( v(k,j+1,i) + v(k,j-2,i) )              &
+                            +      (           ibit23 * adv_mom_5                &
+                                   ) *                                        &
+                                     ( v(k,j+2,i) + v(k,j-3,i) )              &
+                                                 )
+
+             swap_diss_y_local_v(k) = - ABS( v_comp(k) ) * (                  &
+                                   ( 10.0_wp * ibit23 * adv_mom_5                &
+                                +     3.0_wp * ibit22 * adv_mom_3                &
+                                +              ibit21 * adv_mom_1                &
+                                   ) *                                        &
+                                     ( v(k,j,i)   - v(k,j-1,i) )              &
+                            -      (  5.0_wp * ibit23 * adv_mom_5                &
+                                +              ibit22 * adv_mom_3                &
+                                   ) *                                        &
+                                     ( v(k,j+1,i) - v(k,j-2,i) )              &
+                            +      (           ibit23 * adv_mom_5                &
+                                   ) *                                        &
+                                     ( v(k,j+2,i) - v(k,j-3,i) )              &
+                                                          )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             v_comp(k)              = v(k,j,i) + v(k,j-1,i) - gv
+             swap_flux_y_local_v(k) = v_comp(k) * (                           &
+                           37.0_wp * ( v(k,j,i) + v(k,j-1,i)   )                 &
+                         -  8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) )                 &
+                         +           ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5
+             swap_diss_y_local_v(k) = - ABS( v_comp(k) ) * (                  &
+                           10.0_wp * ( v(k,j,i) - v(k,j-1,i)   )                 &
+                         -  5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) )                 &
+                         +           ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5
+
+          ENDDO
+
+          DO  j = nysv, nyn
+
+             flux_t(0) = 0.0_wp
+             diss_t(0) = 0.0_wp
+             flux_d    = 0.0_wp
+             diss_d    = 0.0_wp
+
+             DO  k = nzb+1, nzb_max
+
+                ibit20 = IBITS(wall_flags_0(k,j,i),20,1)
+                ibit19 = IBITS(wall_flags_0(k,j,i),19,1)
+                ibit18 = IBITS(wall_flags_0(k,j,i),18,1)
+
+                u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
+                flux_r(k) = u_comp * (                                       &
+                          ( 37.0_wp * ibit20 * adv_mom_5                        &
+                       +     7.0_wp * ibit19 * adv_mom_3                        &
+                       +              ibit18 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( v(k,j,i+1) + v(k,j,i)   )                 &
+                   -      (  8.0_wp * ibit20 * adv_mom_5                        &
+                       +              ibit19 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( v(k,j,i+2) + v(k,j,i-1) )                 &
+                   +      (           ibit20 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( v(k,j,i+3) + v(k,j,i-2) )                 &
+                                     )
+
+                diss_r(k) = - ABS( u_comp ) * (                              &
+                          ( 10.0_wp * ibit20 * adv_mom_5                        &
+                       +     3.0_wp * ibit19 * adv_mom_3                        &
+                       +              ibit18 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( v(k,j,i+1) - v(k,j,i)  )                  &
+                   -      (  5.0_wp * ibit20 * adv_mom_5                        &
+                       +              ibit19 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( v(k,j,i+2) - v(k,j,i-1) )                 &
+                   +      (           ibit20 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( v(k,j,i+3) - v(k,j,i-2) )                 &
+                                              )
+
+                ibit23 = IBITS(wall_flags_0(k,j,i),23,1)
+                ibit22 = IBITS(wall_flags_0(k,j,i),22,1)
+                ibit21 = IBITS(wall_flags_0(k,j,i),21,1)
+
+                v_comp(k) = v(k,j+1,i) + v(k,j,i)
+                flux_n(k) = ( v_comp(k) - gv ) * (                           &
+                          ( 37.0_wp * ibit23 * adv_mom_5                        &
+                       +     7.0_wp * ibit22 * adv_mom_3                        &
+                       +              ibit21 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( v(k,j+1,i) + v(k,j,i)   )                 &
+                   -      (  8.0_wp * ibit23 * adv_mom_5                        &
+                       +              ibit22 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( v(k,j+2,i) + v(k,j-1,i) )                 &
+                   +      (           ibit23 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( v(k,j+3,i) + v(k,j-2,i) )                 &
+                                     )
+
+                diss_n(k) = - ABS( v_comp(k) - gv ) * (                      &
+                          ( 10.0_wp * ibit23 * adv_mom_5                        &
+                       +     3.0_wp * ibit22 * adv_mom_3                        &
+                       +              ibit21 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( v(k,j+1,i) - v(k,j,i)  )                  &
+                   -      (  5.0_wp * ibit23 * adv_mom_5                        &
+                       +              ibit22 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( v(k,j+2,i) - v(k,j-1,i) )                 &
+                   +      (           ibit23 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( v(k,j+3,i) - v(k,j-2,i) )                 &
+                                                      )
+!
+!--             k index has to be modified near bottom and top, else array
+!--             subscripts will be exceeded.
+                ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
+                ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
+                ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
+
+                k_ppp = k + 3 * ibit26
+                k_pp  = k + 2 * ( 1 - ibit24  )
+                k_mm  = k - 2 * ibit26
+
+                w_comp    = w(k,j-1,i) + w(k,j,i)
+                flux_t(k) = w_comp  * (                                      &
+                          ( 37.0_wp * ibit26 * adv_mom_5                        &
+                       +     7.0_wp * ibit25 * adv_mom_3                        &
+                       +              ibit24 * adv_mom_1                        &
+                          ) *                                                &
+                             ( v(k+1,j,i)   + v(k,j,i)    )                  &
+                   -      (  8.0_wp * ibit26 * adv_mom_5                        &
+                       +              ibit25 * adv_mom_3                        &
+                          ) *                                                &
+                             ( v(k_pp,j,i)  + v(k-1,j,i)  )                  &
+                   +      (           ibit26 * adv_mom_5                        &
+                          ) *                                                &
+                             ( v(k_ppp,j,i) + v(k_mm,j,i) )                  &
+                                      )
+
+                diss_t(k) = - ABS( w_comp ) * (                              &
+                          ( 10.0_wp * ibit26 * adv_mom_5                        &
+                       +     3.0_wp * ibit25 * adv_mom_3                        &
+                       +              ibit24 * adv_mom_1                        &
+                          ) *                                                &
+                             ( v(k+1,j,i)   - v(k,j,i)    )                  &
+                   -      (  5.0_wp * ibit26 * adv_mom_5                        &
+                       +              ibit25 * adv_mom_3                        &
+                          ) *                                                &
+                             ( v(k_pp,j,i)  - v(k-1,j,i)  )                  &
+                   +      (           ibit26 * adv_mom_5                        &
+                          ) *                                                &
+                             ( v(k_ppp,j,i) - v(k_mm,j,i) )                  &
+                                               )
+!
+!--             Calculate the divergence of the velocity field. A respective
+!--             correction is needed to overcome numerical instabilities caused
+!--             by a not sufficient reduction of divergences near topography.
+                div = ( ( ( u_comp     + gu )                                 &
+                                       * ( ibit18 + ibit19 + ibit20 )         &
+                - ( u(k,j-1,i)   + u(k,j,i) )                                 &
+                                       * ( IBITS(wall_flags_0(k,j,i-1),18,1)  &
+                                         + IBITS(wall_flags_0(k,j,i-1),19,1)  &
+                                         + IBITS(wall_flags_0(k,j,i-1),20,1)  &
+                                         )                                    &   
+                  ) * ddx                                                     &
+               +  ( v_comp(k)                                                 &
+                                       * ( ibit21 + ibit22 + ibit23 )         &
+                - ( v(k,j,i)     + v(k,j-1,i) )                               &
+                                       * ( IBITS(wall_flags_0(k,j-1,i),21,1)  &
+                                         + IBITS(wall_flags_0(k,j-1,i),22,1)  &
+                                         + IBITS(wall_flags_0(k,j-1,i),23,1)  &
+                                         )                                    &   
+                  ) * ddy                                                     &
+               +  ( w_comp                                                    &
+                                       * ( ibit24 + ibit25 + ibit26 )         &
+                - ( w(k-1,j-1,i) + w(k-1,j,i) )                               &
+                                       * ( IBITS(wall_flags_0(k-1,j,i),24,1)  &
+                                         + IBITS(wall_flags_0(k-1,j,i),25,1)  &
+                                         + IBITS(wall_flags_0(k-1,j,i),26,1)  &
+                                         )                                    &
+                   ) * ddzw(k)   &
+                ) * 0.5_wp
+
+
+                tend(k,j,i) = tend(k,j,i) - (                                 &
+                       ( flux_r(k) + diss_r(k)                                &
+                     -   swap_flux_x_local_v(k,j) - swap_diss_x_local_v(k,j)  &
+                       ) * ddx                                                &
+                     + ( flux_n(k) + diss_n(k)                                &
+                     -   swap_flux_y_local_v(k) - swap_diss_y_local_v(k)      &
+                       ) * ddy                                                &
+                     + ( flux_t(k) + diss_t(k)                                &
+                     -   flux_d    - diss_d                                   &
+                       ) * ddzw(k)                                            &
+                                            )  + v(k,j,i) * div
+
+                swap_flux_x_local_v(k,j) = flux_r(k)
+                swap_diss_x_local_v(k,j) = diss_r(k)
+                swap_flux_y_local_v(k)   = flux_n(k)
+                swap_diss_y_local_v(k)   = diss_n(k)
+                flux_d                   = flux_t(k)
+                diss_d                   = diss_t(k)
+
+!
+!--             Statistical Evaluation of v'v'. The factor has to be applied
+!--             for right evaluation when gallilei_trans = .T. .
+                sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                     &
+                      + ( flux_n(k)                                           &
+                      * ( v_comp(k) - 2.0_wp * hom(k,1,2,0) )                    &
+                      / ( v_comp(k) - gv + 1.0E-20_wp )                       &
+                      +   diss_n(k)                                           &
+                      *   ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0) )               &
+                      / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) )               &
+                      *   weight_substep(intermediate_timestep_count)
+!
+!--              Statistical Evaluation of w'v'.
+                 sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                  &
+                              + ( flux_t(k) + diss_t(k) )                     &
+                              *   weight_substep(intermediate_timestep_count)
+
+             ENDDO
+
+             DO  k = nzb_max+1, nzt
+
+                u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
+                flux_r(k) = u_comp * (                                        &
+                      37.0_wp * ( v(k,j,i+1) + v(k,j,i)   )                      &
+                    -  8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) )                      &
+                    +           ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_5
+
+                diss_r(k) = - ABS( u_comp ) * (                               &
+                      10.0_wp * ( v(k,j,i+1) - v(k,j,i) )                        &
+                    -  5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) )                      &
+                    +           ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_5
+
+
+                v_comp(k) = v(k,j+1,i) + v(k,j,i)
+                flux_n(k) = ( v_comp(k) - gv ) * (                            &
+                      37.0_wp * ( v(k,j+1,i) + v(k,j,i)   )                      &
+                    -  8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) )                      &
+                      +         ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_5
+
+                diss_n(k) = - ABS( v_comp(k) - gv ) * (                       &
+                      10.0_wp * ( v(k,j+1,i) - v(k,j,i)   )                      &
+                    -  5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) )                      &
+                    +           ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_5
+!
+!--             k index has to be modified near bottom and top, else array
+!--             subscripts will be exceeded.
+                ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
+                ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
+                ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
+
+                k_ppp = k + 3 * ibit26
+                k_pp  = k + 2 * ( 1 - ibit24  )
+                k_mm  = k - 2 * ibit26
+
+                w_comp    = w(k,j-1,i) + w(k,j,i)
+                flux_t(k) = w_comp  * (                                      &
+                          ( 37.0_wp * ibit26 * adv_mom_5                        &
+                       +     7.0_wp * ibit25 * adv_mom_3                        &
+                       +              ibit24 * adv_mom_1                        &
+                          ) *                                                &
+                             ( v(k+1,j,i)   + v(k,j,i)    )                  &
+                   -      (  8.0_wp * ibit26 * adv_mom_5                        &
+                       +              ibit25 * adv_mom_3                        &
+                          ) *                                                &
+                             ( v(k_pp,j,i)  + v(k-1,j,i)  )                  &
+                   +      (           ibit26 * adv_mom_5                        &
+                          ) *                                                &
+                             ( v(k_ppp,j,i) + v(k_mm,j,i) )                  &
+                                      )
+
+                diss_t(k) = - ABS( w_comp ) * (                              &
+                          ( 10.0_wp * ibit26 * adv_mom_5                        &
+                       +     3.0_wp * ibit25 * adv_mom_3                        &
+                       +              ibit24 * adv_mom_1                        &
+                          ) *                                                &
+                             ( v(k+1,j,i)   - v(k,j,i)    )                  &
+                   -      (  5.0_wp * ibit26 * adv_mom_5                        &
+                       +              ibit25 * adv_mom_3                        &
+                          ) *                                                &
+                             ( v(k_pp,j,i)  - v(k-1,j,i)  )                  &
+                   +      (           ibit26 * adv_mom_5                        &
+                          ) *                                                &
+                             ( v(k_ppp,j,i) - v(k_mm,j,i) )                  &
+                                               )
+!
+!--             Calculate the divergence of the velocity field. A respective
+!--             correction is needed to overcome numerical instabilities caused
+!--             by a not sufficient reduction of divergences near topography.
+                div = ( ( u_comp + gu - ( u(k,j-1,i)   + u(k,j,i)   ) ) * ddx &
+                     +  ( v_comp(k)   - ( v(k,j,i)     + v(k,j-1,i) ) ) * ddy &
+                     +  ( w_comp      - ( w(k-1,j-1,i) + w(k-1,j,i) ) )       &
+                                                                    * ddzw(k) &
+                      ) * 0.5_wp
+ 
+                tend(k,j,i) = tend(k,j,i) - (                                 &
+                       ( flux_r(k) + diss_r(k)                                &
+                     -   swap_flux_x_local_v(k,j) - swap_diss_x_local_v(k,j)  &
+                       ) * ddx                                                &
+                     + ( flux_n(k) + diss_n(k)                                &
+                     -   swap_flux_y_local_v(k) - swap_diss_y_local_v(k)      &
+                       ) * ddy                                                &
+                     + ( flux_t(k) + diss_t(k)                                &
+                     -   flux_d    - diss_d                                   &
+                       ) * ddzw(k)                                            &
+                                            )  + v(k,j,i) * div
+
+                swap_flux_x_local_v(k,j) = flux_r(k)
+                swap_diss_x_local_v(k,j) = diss_r(k)
+                swap_flux_y_local_v(k)   = flux_n(k)
+                swap_diss_y_local_v(k)   = diss_n(k)
+                flux_d                   = flux_t(k)
+                diss_d                   = diss_t(k)
+
+!
+!--             Statistical Evaluation of v'v'. The factor has to be applied
+!--             for right evaluation when gallilei_trans = .T. .
+                sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                     &
+                         + ( flux_n(k)                                        &
+                         * ( v_comp(k) - 2.0_wp * hom(k,1,2,0) )                 &
+                         / ( v_comp(k) - gv + 1.0E-20_wp )                    &
+                         +   diss_n(k)                                        &
+                         *   ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0) )            &
+                         / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) )            &
+                         *   weight_substep(intermediate_timestep_count)
+!
+!--             Statistical Evaluation of w'v'.
+                sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                    &
+                              + ( flux_t(k) + diss_t(k) )                      &
+                              *   weight_substep(intermediate_timestep_count)
+
+             ENDDO
+          ENDDO
+       ENDDO
+       sums_vs2_ws_l(nzb,tn) = sums_vs2_ws_l(nzb+1,tn)
+
+
+    END SUBROUTINE advec_v_ws
+    
+    
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Advection of v - Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_v_ws_acc
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, tend, u, v, w
+
+       USE constants,                                                          &
+           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
+
+       USE control_parameters,                                                 &
+           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
+                  nzb_max, nzt, wall_flags_0
+           
+       USE kinds
+       
+!        USE statistics,                                                       &
+!            ONLY:  hom, sums_vs2_ws_l, sums_wsvs_ws_l, weight_substep
+
+       IMPLICIT NONE
+
+
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  ibit18 !<
+       INTEGER(iwp) ::  ibit19 !<
+       INTEGER(iwp) ::  ibit20 !<
+       INTEGER(iwp) ::  ibit21 !<
+       INTEGER(iwp) ::  ibit22 !<
+       INTEGER(iwp) ::  ibit23 !<
+       INTEGER(iwp) ::  ibit24 !<
+       INTEGER(iwp) ::  ibit25 !<
+       INTEGER(iwp) ::  ibit26 !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  k      !<
+       INTEGER(iwp) ::  k_mm   !<
+       INTEGER(iwp) ::  k_mmm  !<
+       INTEGER(iwp) ::  k_pp   !<
+       INTEGER(iwp) ::  k_ppp  !<
+       INTEGER(iwp) ::  tn = 0 !<
+
+       REAL(wp)    ::  diss_d   !<
+       REAL(wp)    ::  diss_l   !<
+       REAL(wp)    ::  diss_n   !<
+       REAL(wp)    ::  diss_r   !<
+       REAL(wp)    ::  diss_s   !<
+       REAL(wp)    ::  diss_t   !<
+       REAL(wp)    ::  div      !<
+       REAL(wp)    ::  flux_d   !<
+       REAL(wp)    ::  flux_l   !<
+       REAL(wp)    ::  flux_n   !<
+       REAL(wp)    ::  flux_r   !<
+       REAL(wp)    ::  flux_s   !<
+       REAL(wp)    ::  flux_t   !<
+       REAL(wp)    ::  gu       !<
+       REAL(wp)    ::  gv       !<
+       REAL(wp)    ::  u_comp   !<
+       REAL(wp)    ::  u_comp_l !<
+       REAL(wp)    ::  v_comp   !<
+       REAL(wp)    ::  v_comp_s !<
+       REAL(wp)    ::  w_comp   !<
+
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+
+!
+!--    Computation of fluxes and tendency terms
+       !$acc kernels present( ddzw, tend, u, v, w, wall_flags_0 )
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+             DO  k = nzb+1, nzt
+
+                ibit20 = IBITS(wall_flags_0(k,j,i-1),20,1)
+                ibit19 = IBITS(wall_flags_0(k,j,i-1),19,1)
+                ibit18 = IBITS(wall_flags_0(k,j,i-1),18,1)
+
+                u_comp_l                 = u(k,j-1,i) + u(k,j,i) - gu
+                flux_l                   = u_comp_l * (                          &
+                                      ( 37.0_wp * ibit20 * adv_mom_5              &
+                                   +     7.0_wp * ibit19 * adv_mom_3              &
+                                   +              ibit18 * adv_mom_1              &
+                                      ) *                                      &
+                                     ( v(k,j,i)   + v(k,j,i-1) )               &
+                               -      (  8.0_wp * ibit20 * adv_mom_5              &
+                                   +              ibit19 * adv_mom_3              &
+                                      ) *                                      &
+                                     ( v(k,j,i+1) + v(k,j,i-2) )               &
+                               +      (           ibit20 * adv_mom_5              &
+                                      ) *                                      &
+                                     ( v(k,j,i+2) + v(k,j,i-3) )               &
+                                                 )
+
+                diss_l                   = - ABS( u_comp_l ) * (                 &
+                                      ( 10.0_wp * ibit20 * adv_mom_5              &
+                                   +     3.0_wp * ibit19 * adv_mom_3              &
+                                   +              ibit18 * adv_mom_1              &
+                                      ) *                                      &
+                                     ( v(k,j,i)   - v(k,j,i-1) )               &
+                               -      (  5.0_wp * ibit20 * adv_mom_5              &
+                                   +              ibit19 * adv_mom_3              &
+                                      ) *                                      &
+                                     ( v(k,j,i+1) - v(k,j,i-2) )               &
+                               +      (           ibit20 * adv_mom_5              &
+                                      ) *                                      &
+                                     ( v(k,j,i+2) - v(k,j,i-3) )               &
+                                                           )
+
+                ibit20 = IBITS(wall_flags_0(k,j,i),20,1)
+                ibit19 = IBITS(wall_flags_0(k,j,i),19,1)
+                ibit18 = IBITS(wall_flags_0(k,j,i),18,1)
+
+                u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
+                flux_r    = u_comp * (                                       &
+                          ( 37.0_wp * ibit20 * adv_mom_5                        &
+                       +     7.0_wp * ibit19 * adv_mom_3                        &
+                       +              ibit18 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( v(k,j,i+1) + v(k,j,i)   )                 &
+                   -      (  8.0_wp * ibit20 * adv_mom_5                        &
+                       +              ibit19 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( v(k,j,i+2) + v(k,j,i-1) )                 &
+                   +      (           ibit20 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( v(k,j,i+3) + v(k,j,i-2) )                 &
+                                     )
+
+                diss_r    = - ABS( u_comp ) * (                              &
+                          ( 10.0_wp * ibit20 * adv_mom_5                        &
+                       +     3.0_wp * ibit19 * adv_mom_3                        &
+                       +              ibit18 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( v(k,j,i+1) - v(k,j,i)  )                  &
+                   -      (  5.0_wp * ibit20 * adv_mom_5                        &
+                       +              ibit19 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( v(k,j,i+2) - v(k,j,i-1) )                 &
+                   +      (           ibit20 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( v(k,j,i+3) - v(k,j,i-2) )                 &
+                                              )
+
+                ibit23 = IBITS(wall_flags_0(k,j-1,i),23,1)
+                ibit22 = IBITS(wall_flags_0(k,j-1,i),22,1)
+                ibit21 = IBITS(wall_flags_0(k,j-1,i),21,1)
+
+
+                v_comp_s              = v(k,j,i) + v(k,j-1,i) - gv
+                flux_s                = v_comp_s    * (                       &
+                                   ( 37.0_wp * ibit23 * adv_mom_5                &
+                                +     7.0_wp * ibit22 * adv_mom_3                &
+                                +              ibit21 * adv_mom_1                &
+                                   ) *                                        &
+                                     ( v(k,j,i)   + v(k,j-1,i) )              &
+                            -      (  8.0_wp * ibit23 * adv_mom_5                &
+                                +              ibit22 * adv_mom_3                &
+                                   ) *                                        &
+                                     ( v(k,j+1,i) + v(k,j-2,i) )              &
+                            +      (           ibit23 * adv_mom_5                &
+                                   ) *                                        &
+                                     ( v(k,j+2,i) + v(k,j-3,i) )              &
+                                                 )
+
+                diss_s                = - ABS( v_comp_s ) * (                 &
+                                   ( 10.0_wp * ibit23 * adv_mom_5                &
+                                +     3.0_wp * ibit22 * adv_mom_3                &
+                                +              ibit21 * adv_mom_1                &
+                                   ) *                                        &
+                                     ( v(k,j,i)   - v(k,j-1,i) )              &
+                            -      (  5.0_wp * ibit23 * adv_mom_5                &
+                                +              ibit22 * adv_mom_3                &
+                                   ) *                                        &
+                                     ( v(k,j+1,i) - v(k,j-2,i) )              &
+                            +      (           ibit23 * adv_mom_5                &
+                                   ) *                                        &
+                                     ( v(k,j+2,i) - v(k,j-3,i) )              &
+                                                          )
+
+                ibit23 = IBITS(wall_flags_0(k,j,i),23,1)
+                ibit22 = IBITS(wall_flags_0(k,j,i),22,1)
+                ibit21 = IBITS(wall_flags_0(k,j,i),21,1)
+
+                v_comp = v(k,j+1,i) + v(k,j,i)
+                flux_n = ( v_comp - gv ) * (                                 &
+                          ( 37.0_wp * ibit23 * adv_mom_5                        &
+                       +     7.0_wp * ibit22 * adv_mom_3                        &
+                       +              ibit21 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( v(k,j+1,i) + v(k,j,i)   )                 &
+                   -      (  8.0_wp * ibit23 * adv_mom_5                        &
+                       +              ibit22 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( v(k,j+2,i) + v(k,j-1,i) )                 &
+                   +      (           ibit23 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( v(k,j+3,i) + v(k,j-2,i) )                 &
+                                     )
+
+                diss_n = - ABS( v_comp - gv ) * (                         &
+                          ( 10.0_wp * ibit23 * adv_mom_5                        &
+                       +     3.0_wp * ibit22 * adv_mom_3                        &
+                       +              ibit21 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( v(k,j+1,i) - v(k,j,i)  )                  &
+                   -      (  5.0_wp * ibit23 * adv_mom_5                        &
+                       +              ibit22 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( v(k,j+2,i) - v(k,j-1,i) )                 &
+                   +      (           ibit23 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( v(k,j+3,i) - v(k,j-2,i) )                 &
+                                                     )
+
+                ibit26 = IBITS(wall_flags_0(k-1,j,i),26,1)
+                ibit25 = IBITS(wall_flags_0(k-1,j,i),25,1)
+                ibit24 = IBITS(wall_flags_0(k-1,j,i),24,1)
+
+                k_pp  = k + 2 * ibit26
+                k_mm  = k - 2 * ( ibit25 + ibit26 )
+                k_mmm = k - 3 * ibit26
+
+                w_comp    = w(k-1,j-1,i) + w(k-1,j,i)
+                flux_d    = w_comp  * (                                      &
+                          ( 37.0_wp * ibit26 * adv_mom_5                        &
+                       +     7.0_wp * ibit25 * adv_mom_3                        &
+                       +              ibit24 * adv_mom_1                        &
+                          ) *                                                &
+                             ( v(k,j,i)     + v(k-1,j,i)  )                  &
+                   -      (  8.0_wp * ibit26 * adv_mom_5                        &
+                       +              ibit25 * adv_mom_3                        &
+                          ) *                                                &
+                             ( v(k+1,j,i)  + v(k_mm,j,i)  )                  &
+                   +      (           ibit26 * adv_mom_5                        &
+                          ) *                                                &
+                             ( v(k_pp,j,i) + v(k_mmm,j,i) )                  &
+                                      )
+
+                diss_d    = - ABS( w_comp ) * (                              &
+                          ( 10.0_wp * ibit26 * adv_mom_5                        &
+                       +     3.0_wp * ibit25 * adv_mom_3                        &
+                       +              ibit24 * adv_mom_1                        &
+                          ) *                                                &
+                             ( v(k,j,i)     - v(k-1,j,i)  )                  &
+                   -      (  5.0_wp * ibit26 * adv_mom_5                        &
+                       +              ibit25 * adv_mom_3                        &
+                          ) *                                                &
+                             ( v(k+1,j,i)  - v(k_mm,j,i)  )                  &
+                   +      (           ibit26 * adv_mom_5                        &
+                          ) *                                                &
+                             ( v(k_pp,j,i) - v(k_mmm,j,i) )                  &
+                                               )
+!
+!--             k index has to be modified near bottom and top, else array
+!--             subscripts will be exceeded.
+                ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
+                ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
+                ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
+
+                k_ppp = k + 3 * ibit26
+                k_pp  = k + 2 * ( 1 - ibit24  )
+                k_mm  = k - 2 * ibit26
+
+                w_comp    = w(k,j-1,i) + w(k,j,i)
+                flux_t    = w_comp  * (                                      &
+                          ( 37.0_wp * ibit26 * adv_mom_5                        &
+                       +     7.0_wp * ibit25 * adv_mom_3                        &
+                       +              ibit24 * adv_mom_1                        &
+                          ) *                                                &
+                             ( v(k+1,j,i)   + v(k,j,i)    )                  &
+                   -      (  8.0_wp * ibit26 * adv_mom_5                        &
+                       +              ibit25 * adv_mom_3                        &
+                          ) *                                                &
+                             ( v(k_pp,j,i)  + v(k-1,j,i)  )                  &
+                   +      (           ibit26 * adv_mom_5                        &
+                          ) *                                                &
+                             ( v(k_ppp,j,i) + v(k_mm,j,i) )                  &
+                                      )
+
+                diss_t    = - ABS( w_comp ) * (                              &
+                          ( 10.0_wp * ibit26 * adv_mom_5                        &
+                       +     3.0_wp * ibit25 * adv_mom_3                        &
+                       +              ibit24 * adv_mom_1                        &
+                          ) *                                                &
+                             ( v(k+1,j,i)   - v(k,j,i)    )                  &
+                   -      (  5.0_wp * ibit26 * adv_mom_5                        &
+                       +              ibit25 * adv_mom_3                        &
+                          ) *                                                &
+                             ( v(k_pp,j,i)  - v(k-1,j,i)  )                  &
+                   +      (           ibit26 * adv_mom_5                        &
+                          ) *                                                &
+                             ( v(k_ppp,j,i) - v(k_mm,j,i) )                  &
+                                               )
+!
+!--             Calculate the divergence of the velocity field. A respective
+!--             correction is needed to overcome numerical instabilities caused
+!--             by a not sufficient reduction of divergences near topography.
+                div = ( ( ( u_comp     + gu )                                 &
+                                       * ( ibit18 + ibit19 + ibit20 )         &
+                - ( u(k,j-1,i)   + u(k,j,i) )                                 &
+                                       * ( IBITS(wall_flags_0(k,j,i-1),18,1)  &
+                                         + IBITS(wall_flags_0(k,j,i-1),19,1)  &
+                                         + IBITS(wall_flags_0(k,j,i-1),20,1)  &
+                                         )                                    &   
+                  ) * ddx                                                     &
+               +  ( v_comp                                                    &
+                                       * ( ibit21 + ibit22 + ibit23 )         &
+                - ( v(k,j,i)     + v(k,j-1,i) )                               &
+                                       * ( IBITS(wall_flags_0(k,j-1,i),21,1)  &
+                                         + IBITS(wall_flags_0(k,j-1,i),22,1)  &
+                                         + IBITS(wall_flags_0(k,j-1,i),23,1)  &
+                                         )                                    &   
+                  ) * ddy                                                     &
+               +  ( w_comp                                                    &
+                                       * ( ibit24 + ibit25 + ibit26 )         &
+                - ( w(k-1,j-1,i) + w(k-1,j,i) )                               &
+                                       * ( IBITS(wall_flags_0(k-1,j,i),24,1)  &
+                                         + IBITS(wall_flags_0(k-1,j,i),25,1)  &
+                                         + IBITS(wall_flags_0(k-1,j,i),26,1)  &
+                                         )                                    &
+                   ) * ddzw(k)   &
+                ) * 0.5_wp
+
+
+                tend(k,j,i) = - (                                              &
+                               ( flux_r + diss_r - flux_l - diss_l ) * ddx     &
+                             + ( flux_n + diss_n - flux_s - diss_s ) * ddy     &
+                             + ( flux_t + diss_t - flux_d - diss_d ) * ddzw(k) &
+                                ) + div * v(k,j,i)
+
+
+!++
+!--             Statistical Evaluation of v'v'. The factor has to be applied
+!--             for right evaluation when gallilei_trans = .T. .
+!                sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                  &
+!                      + ( flux_n                                           &
+!                      * ( v_comp - 2.0_wp * hom(k,1,2,0) )                    &
+!                      / ( v_comp - gv + 1.0E-20_wp )                       &
+!                      +   diss_n                                           &
+!                      *   ABS( v_comp - 2.0_wp * hom(k,1,2,0) )               &
+!                      / ( ABS( v_comp - gv ) +1.0E-20_wp ) )               &
+!                      *   weight_substep(intermediate_timestep_count)
+!
+!--              Statistical Evaluation of w'v'.
+!                 sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                &
+!                              + ( flux_t + diss_t )                         &
+!                              *   weight_substep(intermediate_timestep_count)
+
+             ENDDO
+          ENDDO
+       ENDDO
+       !$acc end kernels
+
+!++
+!       sums_vs2_ws_l(nzb,tn) = sums_vs2_ws_l(nzb+1,tn)
+
+    END SUBROUTINE advec_v_ws_acc
+    
+    
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Advection of w - Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_w_ws
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, tend, u, v, w
+
+       USE constants,                                                          &
+           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
+
+       USE control_parameters,                                                 &
+           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0,         &
+                  wall_flags_00
+
+       USE kinds
+       
+       USE statistics,                                                         &
+           ONLY:  hom, sums_ws2_ws_l, weight_substep
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  ibit27 !<
+       INTEGER(iwp) ::  ibit28 !<
+       INTEGER(iwp) ::  ibit29 !<
+       INTEGER(iwp) ::  ibit30 !<
+       INTEGER(iwp) ::  ibit31 !<
+       INTEGER(iwp) ::  ibit32 !<
+       INTEGER(iwp) ::  ibit33 !<
+       INTEGER(iwp) ::  ibit34 !<
+       INTEGER(iwp) ::  ibit35 !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  k      !<
+       INTEGER(iwp) ::  k_mm   !<
+       INTEGER(iwp) ::  k_pp   !<
+       INTEGER(iwp) ::  k_ppp  !<
+       INTEGER(iwp) ::  tn = 0 !<
+       
+       REAL(wp)    ::  diss_d !<
+       REAL(wp)    ::  div    !<
+       REAL(wp)    ::  flux_d !<
+       REAL(wp)    ::  gu     !<
+       REAL(wp)    ::  gv     !<
+       REAL(wp)    ::  u_comp !<
+       REAL(wp)    ::  v_comp !<
+       REAL(wp)    ::  w_comp !<
+       
+       REAL(wp), DIMENSION(nzb:nzt)    ::  diss_t !<
+       REAL(wp), DIMENSION(nzb:nzt)    ::  flux_t !<
+       
+       REAL(wp), DIMENSION(nzb+1:nzt)  ::  diss_n !<
+       REAL(wp), DIMENSION(nzb+1:nzt)  ::  diss_r !<
+       REAL(wp), DIMENSION(nzb+1:nzt)  ::  flux_n !<
+       REAL(wp), DIMENSION(nzb+1:nzt)  ::  flux_r !<
+       REAL(wp), DIMENSION(nzb+1:nzt)  ::  swap_diss_y_local_w !<
+       REAL(wp), DIMENSION(nzb+1:nzt)  ::  swap_flux_y_local_w !<
+       
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_w !<
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local_w !<
+ 
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+!
+!--   compute the whole left boundary of the processor domain
+       i = nxl
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzb_max
+
+             ibit29 = IBITS(wall_flags_0(k,j,i-1),29,1)
+             ibit28 = IBITS(wall_flags_0(k,j,i-1),28,1)
+             ibit27 = IBITS(wall_flags_0(k,j,i-1),27,1)
+
+             u_comp                   = u(k+1,j,i) + u(k,j,i) - gu
+             swap_flux_x_local_w(k,j) = u_comp * (                             &
+                                      ( 37.0_wp * ibit29 * adv_mom_5              &
+                                   +     7.0_wp * ibit28 * adv_mom_3              &
+                                   +              ibit27 * adv_mom_1              &
+                                      ) *                                      &
+                                     ( w(k,j,i)   + w(k,j,i-1) )               &
+                               -      (  8.0_wp * ibit29 * adv_mom_5              &
+                                   +              ibit28 * adv_mom_3              &
+                                      ) *                                      &
+                                     ( w(k,j,i+1) + w(k,j,i-2) )               &
+                               +      (           ibit29 * adv_mom_5              &
+                                      ) *                                      &
+                                     ( w(k,j,i+2) + w(k,j,i-3) )               &
+                                                 )
+
+               swap_diss_x_local_w(k,j) = - ABS( u_comp ) * (                  &
+                                        ( 10.0_wp * ibit29 * adv_mom_5            &
+                                     +     3.0_wp * ibit28 * adv_mom_3            &
+                                     +              ibit27 * adv_mom_1            &
+                                        ) *                                    &
+                                     ( w(k,j,i)   - w(k,j,i-1) )               &
+                                 -      (  5.0_wp * ibit29 * adv_mom_5            &
+                                     +              ibit28 * adv_mom_3            &
+                                        ) *                                    &
+                                     ( w(k,j,i+1) - w(k,j,i-2) )               &
+                                 +      (           ibit29 * adv_mom_5            &
+                                        ) *                                    &
+                                     ( w(k,j,i+2) - w(k,j,i-3) )               &
+                                                            )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             u_comp                   = u(k+1,j,i) + u(k,j,i) - gu
+             swap_flux_x_local_w(k,j) = u_comp * (                             &
+                            37.0_wp * ( w(k,j,i) + w(k,j,i-1)   )                 &
+                          -  8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) )                 &
+                          +           ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5
+             swap_diss_x_local_w(k,j) = - ABS( u_comp ) * (                    &
+                            10.0_wp * ( w(k,j,i) - w(k,j,i-1)   )                 &
+                          -  5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) )                 &
+                          +           ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5
+
+          ENDDO
+
+       ENDDO
+
+       DO i = nxl, nxr
+
+          j = nys
+          DO  k = nzb+1, nzb_max
+
+             ibit32 = IBITS(wall_flags_00(k,j-1,i),0,1)
+             ibit31 = IBITS(wall_flags_0(k,j-1,i),31,1)
+             ibit30 = IBITS(wall_flags_0(k,j-1,i),30,1)
+
+             v_comp                 = v(k+1,j,i) + v(k,j,i) - gv
+             swap_flux_y_local_w(k) = v_comp * (                              &
+                                    ( 37.0_wp * ibit32 * adv_mom_5               &
+                                 +     7.0_wp * ibit31 * adv_mom_3               &
+                                 +              ibit30 * adv_mom_1               &
+                                    ) *                                        &
+                                     ( w(k,j,i)   + w(k,j-1,i) )              &
+                             -      (  8.0_wp * ibit32 * adv_mom_5               &
+                                 +              ibit31 * adv_mom_3               &
+                                    ) *                                       &
+                                     ( w(k,j+1,i) + w(k,j-2,i) )              &
+                             +      (           ibit32 * adv_mom_5               &
+                                    ) *                                       &
+                                     ( w(k,j+2,i) + w(k,j-3,i) )              &
+                                               )
+
+             swap_diss_y_local_w(k) = - ABS( v_comp ) * (                     &
+                                    ( 10.0_wp * ibit32 * adv_mom_5               &
+                                 +     3.0_wp * ibit31 * adv_mom_3               &
+                                 +              ibit30 * adv_mom_1               &
+                                    ) *                                       &
+                                     ( w(k,j,i)   - w(k,j-1,i) )              &
+                             -      (  5.0_wp * ibit32 * adv_mom_5               &
+                                 +              ibit31 * adv_mom_3               &
+                                    ) *                                       &
+                                     ( w(k,j+1,i) - w(k,j-2,i) )              &
+                             +      (           ibit32 * adv_mom_5               &
+                                    ) *                                       &
+                                     ( w(k,j+2,i) - w(k,j-3,i) )              &
+                                                        )
+
+          ENDDO
+
+          DO  k = nzb_max+1, nzt
+
+             v_comp                 = v(k+1,j,i) + v(k,j,i) - gv
+             swap_flux_y_local_w(k) = v_comp * (                              &
+                           37.0_wp * ( w(k,j,i) + w(k,j-1,i)   )                 &
+                         -  8.0_wp * ( w(k,j+1,i) +w(k,j-2,i)  )                 &
+                         +           ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5
+             swap_diss_y_local_w(k) = - ABS( v_comp ) * (                     &
+                           10.0_wp * ( w(k,j,i) - w(k,j-1,i)   )                 &
+                         -  5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) )                 &
+                         +           ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5
+
+          ENDDO
+
+          DO  j = nys, nyn
+
+!
+!--          The lower flux has to be calculated explicetely for the tendency
+!--          at the first w-level. For topography wall this is done implicitely
+!--          by wall_flags_0.
+             k         = nzb + 1
+             w_comp    = w(k,j,i) + w(k-1,j,i)
+             flux_t(0) = w_comp       * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1
+             diss_t(0) = -ABS(w_comp) * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1
+             flux_d    = flux_t(0)
+             diss_d    = diss_t(0)
+
+             DO  k = nzb+1, nzb_max
+
+                ibit29 = IBITS(wall_flags_0(k,j,i),29,1)
+                ibit28 = IBITS(wall_flags_0(k,j,i),28,1)
+                ibit27 = IBITS(wall_flags_0(k,j,i),27,1)
+
+                u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
+                flux_r(k) = u_comp * (                                       &
+                          ( 37.0_wp * ibit29 * adv_mom_5                        &
+                       +     7.0_wp * ibit28 * adv_mom_3                        &
+                       +              ibit27 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( w(k,j,i+1) + w(k,j,i)   )                 &
+                   -      (  8.0_wp * ibit29 * adv_mom_5                        &
+                       +              ibit28 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( w(k,j,i+2) + w(k,j,i-1) )                 &
+                   +      (           ibit29 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( w(k,j,i+3) + w(k,j,i-2) )                 &
+                                     )
+
+                diss_r(k) = - ABS( u_comp ) * (                              &
+                          ( 10.0_wp * ibit29 * adv_mom_5                        &
+                       +     3.0_wp * ibit28 * adv_mom_3                        &
+                       +              ibit27 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( w(k,j,i+1) - w(k,j,i)  )                  &
+                   -      (  5.0_wp * ibit29 * adv_mom_5                        &
+                       +              ibit28 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( w(k,j,i+2) - w(k,j,i-1) )                 &
+                   +      (           ibit29 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( w(k,j,i+3) - w(k,j,i-2) )                 &
+                                              )
+
+                ibit32 = IBITS(wall_flags_00(k,j,i),0,1)
+                ibit31 = IBITS(wall_flags_0(k,j,i),31,1)
+                ibit30 = IBITS(wall_flags_0(k,j,i),30,1)
+
+                v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
+                flux_n(k) = v_comp * (                                       &
+                          ( 37.0_wp * ibit32 * adv_mom_5                        &
+                       +     7.0_wp * ibit31 * adv_mom_3                        &
+                       +              ibit30 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( w(k,j+1,i) + w(k,j,i)   )                 &
+                   -      (  8.0_wp * ibit32 * adv_mom_5                        &
+                       +              ibit31 * adv_mom_3                        &
+                          ) *                                                 &
+                                 ( w(k,j+2,i) + w(k,j-1,i) )                 &
+                   +      (           ibit32 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( w(k,j+3,i) + w(k,j-2,i) )                 &
+                                     )
+
+                diss_n(k) = - ABS( v_comp ) * (                              &
+                          ( 10.0_wp * ibit32 * adv_mom_5                        &
+                       +     3.0_wp * ibit31 * adv_mom_3                        &
+                       +              ibit30 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( w(k,j+1,i) - w(k,j,i)  )                  &
+                   -      (  5.0_wp * ibit32 * adv_mom_5                        &
+                       +              ibit31 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( w(k,j+2,i) - w(k,j-1,i) )                 &
+                   +      (           ibit32 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( w(k,j+3,i) - w(k,j-2,i) )                 &
+                                              )
+!
+!--             k index has to be modified near bottom and top, else array
+!--             subscripts will be exceeded.
+                ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
+                ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
+                ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
+
+                k_ppp = k + 3 * ibit35
+                k_pp  = k + 2 * ( 1 - ibit33  )
+                k_mm  = k - 2 * ibit35
+
+                w_comp    = w(k+1,j,i) + w(k,j,i)
+                flux_t(k) = w_comp  * (                                      &
+                          ( 37.0_wp * ibit35 * adv_mom_5                        &
+                       +     7.0_wp * ibit34 * adv_mom_3                        &
+                       +              ibit33 * adv_mom_1                        &
+                          ) *                                                &
+                             ( w(k+1,j,i)  + w(k,j,i)     )                  &
+                   -      (  8.0_wp * ibit35 * adv_mom_5                        &
+                       +              ibit34 * adv_mom_3                        &
+                          ) *                                                &
+                             ( w(k_pp,j,i)  + w(k-1,j,i)  )                  &
+                   +      (           ibit35 * adv_mom_5                        &
+                          ) *                                                &
+                             ( w(k_ppp,j,i) + w(k_mm,j,i) )                  &
+                                       )
+
+                diss_t(k) = - ABS( w_comp ) * (                              &
+                          ( 10.0_wp * ibit35 * adv_mom_5                        &
+                       +     3.0_wp * ibit34 * adv_mom_3                        &
+                       +              ibit33 * adv_mom_1                        &
+                          ) *                                                &
+                             ( w(k+1,j,i)   - w(k,j,i)    )                  &
+                   -      (  5.0_wp * ibit35 * adv_mom_5                        &
+                       +              ibit34 * adv_mom_3                        &
+                          ) *                                                &
+                             ( w(k_pp,j,i)  - w(k-1,j,i)  )                  &
+                   +      (           ibit35 * adv_mom_5                        &
+                          ) *                                                &
+                             ( w(k_ppp,j,i) - w(k_mm,j,i) )                  &
+                                               )
+!
+!--             Calculate the divergence of the velocity field. A respective
+!--             correction is needed to overcome numerical instabilities caused
+!--             by a not sufficient reduction of divergences near topography.
+                div = ( ( ( u_comp + gu ) * ( ibit27 + ibit28 + ibit29 )      &
+                  - ( u(k+1,j,i) + u(k,j,i)   )                               & 
+                                    * ( IBITS(wall_flags_0(k,j,i-1),27,1)     &
+                                      + IBITS(wall_flags_0(k,j,i-1),28,1)     &
+                                      + IBITS(wall_flags_0(k,j,i-1),29,1)     &
+                                      )                                       &
+                  ) * ddx                                                     &
+              +   ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 )            & 
+                  - ( v(k+1,j,i) + v(k,j,i)   )                               &
+                                    * ( IBITS(wall_flags_0(k,j-1,i),30,1)     &
+                                      + IBITS(wall_flags_0(k,j-1,i),31,1)     &
+                                      + IBITS(wall_flags_00(k,j-1,i),0,1)     &
+                                      )                                       &
+                  ) * ddy                                                     &
+              +   ( w_comp          * ( ibit33 + ibit34 + ibit35 )            &
+                - ( w(k,j,i)   + w(k-1,j,i)   )                               &
+                                    * ( IBITS(wall_flags_00(k-1,j,i),1,1)     &
+                                      + IBITS(wall_flags_00(k-1,j,i),2,1)     &
+                                      + IBITS(wall_flags_00(k-1,j,i),3,1)     &
+                                      )                                       & 
+                  ) * ddzu(k+1)   &
+                ) * 0.5_wp
+
+
+
+                tend(k,j,i) = tend(k,j,i) - (                                 &
+                      ( flux_r(k) + diss_r(k)                                 &
+                    -   swap_flux_x_local_w(k,j) - swap_diss_x_local_w(k,j)   &
+                      ) * ddx                                                 &
+                    + ( flux_n(k) + diss_n(k)                                 &
+                    -   swap_flux_y_local_w(k)   - swap_diss_y_local_w(k)     &
+                      ) * ddy                                                 &
+                    + ( flux_t(k) + diss_t(k)                                 &
+                    -   flux_d    - diss_d                                    &
+                      ) * ddzu(k+1)                                           &
+                                            )  + div * w(k,j,i)
+
+                swap_flux_x_local_w(k,j) = flux_r(k)
+                swap_diss_x_local_w(k,j) = diss_r(k)
+                swap_flux_y_local_w(k)   = flux_n(k)
+                swap_diss_y_local_w(k)   = diss_n(k)
+                flux_d                   = flux_t(k)
+                diss_d                   = diss_t(k)
+
+                sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                    &
+                               + ( flux_t(k) + diss_t(k) )                    &
+                               *   weight_substep(intermediate_timestep_count)
+
+             ENDDO
+
+             DO  k = nzb_max+1, nzt
+
+                u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
+                flux_r(k) = u_comp * (                                      &
+                      37.0_wp * ( w(k,j,i+1) + w(k,j,i)   )                    &
+                    -  8.0_wp * ( w(k,j,i+2) + w(k,j,i-1) )                    &
+                    +           ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_5
+
+                diss_r(k) = - ABS( u_comp ) * (                             &
+                      10.0_wp * ( w(k,j,i+1) - w(k,j,i)   )                    &
+                    -  5.0_wp * ( w(k,j,i+2) - w(k,j,i-1) )                    &
+                    +           ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_5
+
+                v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
+                flux_n(k) = v_comp * (                                      &
+                      37.0_wp * ( w(k,j+1,i) + w(k,j,i)   )                    &
+                    -  8.0_wp * ( w(k,j+2,i) + w(k,j-1,i) )                    &
+                    +           ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_5
+
+                diss_n(k) = - ABS( v_comp ) * (                             &
+                      10.0_wp * ( w(k,j+1,i) - w(k,j,i)   )                    &
+                    -  5.0_wp * ( w(k,j+2,i) - w(k,j-1,i) )                    &
+                    +           ( w(k,j+3,i) - w(k,j-2,i) ) ) * adv_mom_5
+!
+!--             k index has to be modified near bottom and top, else array
+!--             subscripts will be exceeded.
+                ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
+                ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
+                ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
+
+                k_ppp = k + 3 * ibit35
+                k_pp  = k + 2 * ( 1 - ibit33  )
+                k_mm  = k - 2 * ibit35
+
+                w_comp    = w(k+1,j,i) + w(k,j,i)
+                flux_t(k) = w_comp  * (                                      &
+                          ( 37.0_wp * ibit35 * adv_mom_5                        &
+                       +     7.0_wp * ibit34 * adv_mom_3                        &
+                       +              ibit33 * adv_mom_1                        &
+                          ) *                                                &
+                             ( w(k+1,j,i)  + w(k,j,i)     )                  &
+                   -      (  8.0_wp * ibit35 * adv_mom_5                        &
+                       +              ibit34 * adv_mom_3                        &
+                          ) *                                                &
+                             ( w(k_pp,j,i)  + w(k-1,j,i)  )                  &
+                   +      (           ibit35 * adv_mom_5                        &
+                          ) *                                                &
+                             ( w(k_ppp,j,i) + w(k_mm,j,i) )                  &
+                                       )
+
+                diss_t(k) = - ABS( w_comp ) * (                              &
+                          ( 10.0_wp * ibit35 * adv_mom_5                        &
+                       +     3.0_wp * ibit34 * adv_mom_3                        &
+                       +              ibit33 * adv_mom_1                        &
+                          ) *                                                &
+                             ( w(k+1,j,i)   - w(k,j,i)    )                  &
+                   -      (  5.0_wp * ibit35 * adv_mom_5                        &
+                       +              ibit34 * adv_mom_3                        &
+                          ) *                                                &
+                             ( w(k_pp,j,i)  - w(k-1,j,i)  )                  &
+                   +      (           ibit35 * adv_mom_5                        &
+                          ) *                                                &
+                             ( w(k_ppp,j,i) - w(k_mm,j,i) )                  &
+                                               )
+!
+!--             Calculate the divergence of the velocity field. A respective
+!--             correction is needed to overcome numerical instabilities caused
+!--             by a not sufficient reduction of divergences near topography.
+                div = ( ( u_comp + gu - ( u(k+1,j,i) + u(k,j,i)   ) ) * ddx  &
+                    +   ( v_comp + gv - ( v(k+1,j,i) + v(k,j,i)   ) ) * ddy  &
+                    +   ( w_comp      - ( w(k,j,i)   + w(k-1,j,i) ) )        &
+                                                                 * ddzu(k+1) &
+                      ) * 0.5_wp
+
+                tend(k,j,i) = tend(k,j,i) - (                                 &
+                      ( flux_r(k) + diss_r(k)                                 &
+                    -   swap_flux_x_local_w(k,j) - swap_diss_x_local_w(k,j)   &
+                      ) * ddx                                                 &
+                    + ( flux_n(k) + diss_n(k)                                 &
+                    -   swap_flux_y_local_w(k)   - swap_diss_y_local_w(k)     &
+                      ) * ddy                                                 &
+                    + ( flux_t(k) + diss_t(k)                                 &
+                    -   flux_d    - diss_d                                    &
+                      ) * ddzu(k+1)                                           &
+                                            )  + div * w(k,j,i)
+
+                swap_flux_x_local_w(k,j) = flux_r(k)
+                swap_diss_x_local_w(k,j) = diss_r(k)
+                swap_flux_y_local_w(k)   = flux_n(k)
+                swap_diss_y_local_w(k)   = diss_n(k)
+                flux_d                   = flux_t(k)
+                diss_d                   = diss_t(k)
+
+                sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                    &
+                               + ( flux_t(k) + diss_t(k) )                    &
+                               *   weight_substep(intermediate_timestep_count)
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE advec_w_ws
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Advection of w - Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE advec_w_ws_acc
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, tend, u, v, w
+
+       USE constants,                                                          &
+           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
+
+       USE control_parameters,                                                 &
+           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy
+
+       USE indices,                                                            &
+           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
+                  nzb_max, nzt, wall_flags_0, wall_flags_00
+           
+       USE kinds
+       
+!        USE statistics,                                                       &
+!            ONLY:  hom, sums_ws2_ws_l, weight_substep
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  ibit27 !<
+       INTEGER(iwp) ::  ibit28 !<
+       INTEGER(iwp) ::  ibit29 !<
+       INTEGER(iwp) ::  ibit30 !<
+       INTEGER(iwp) ::  ibit31 !<
+       INTEGER(iwp) ::  ibit32 !<
+       INTEGER(iwp) ::  ibit33 !<
+       INTEGER(iwp) ::  ibit34 !<
+       INTEGER(iwp) ::  ibit35 !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  k      !<
+       INTEGER(iwp) ::  k_mmm  !<
+       INTEGER(iwp) ::  k_mm   !<
+       INTEGER(iwp) ::  k_pp   !<
+       INTEGER(iwp) ::  k_ppp  !<
+       INTEGER(iwp) ::  tn = 0 !<
+
+       REAL(wp)    ::  diss_d   !<
+       REAL(wp)    ::  diss_l   !<
+       REAL(wp)    ::  diss_n   !<
+       REAL(wp)    ::  diss_r   !<
+       REAL(wp)    ::  diss_s   !<
+       REAL(wp)    ::  diss_t   !<
+       REAL(wp)    ::  div      !<
+       REAL(wp)    ::  flux_d   !<
+       REAL(wp)    ::  flux_l   !<
+       REAL(wp)    ::  flux_n   !<
+       REAL(wp)    ::  flux_r   !<
+       REAL(wp)    ::  flux_s   !<
+       REAL(wp)    ::  flux_t   !<
+       REAL(wp)    ::  gu       !<
+       REAL(wp)    ::  gv       !<
+       REAL(wp)    ::  u_comp   !<
+       REAL(wp)    ::  u_comp_l !<
+       REAL(wp)    ::  v_comp   !<
+       REAL(wp)    ::  v_comp_s !<
+       REAL(wp)    ::  w_comp   !<
+
+       gu = 2.0_wp * u_gtrans
+       gv = 2.0_wp * v_gtrans
+
+
+!
+!--    Computation of fluxes and tendency terms
+       !$acc kernels present( ddzu, tend, u, v, w, wall_flags_0, wall_flags_00 )
+       DO i = i_left, i_right
+          DO  j = j_south, j_north
+             DO  k = nzb+1, nzt
+
+                ibit27 = IBITS(wall_flags_0(k,j,i-1),27,1)
+                ibit28 = IBITS(wall_flags_0(k,j,i-1),28,1)
+                ibit29 = IBITS(wall_flags_0(k,j,i-1),29,1)
+
+                u_comp_l                 = u(k+1,j,i) + u(k,j,i) - gu
+                flux_l                   = u_comp_l * (                        &
+                                      ( 37.0_wp * ibit29 * adv_mom_5              &
+                                   +     7.0_wp * ibit28 * adv_mom_3              &
+                                   +              ibit27 * adv_mom_1              &
+                                      ) *                                      &
+                                     ( w(k,j,i)   + w(k,j,i-1) )               &
+                               -      (  8.0_wp * ibit29 * adv_mom_5              &
+                                   +              ibit28 * adv_mom_3              &
+                                      ) *                                      &
+                                     ( w(k,j,i+1) + w(k,j,i-2) )               &
+                               +      (           ibit29 * adv_mom_5              &
+                                      ) *                                      &
+                                     ( w(k,j,i+2) + w(k,j,i-3) )               &
+                                                 )
+
+                diss_l                    = - ABS( u_comp_l ) * (              &
+                                        ( 10.0_wp * ibit29 * adv_mom_5            &
+                                     +     3.0_wp * ibit28 * adv_mom_3            &
+                                     +              ibit27 * adv_mom_1            &
+                                        ) *                                    &
+                                     ( w(k,j,i)   - w(k,j,i-1) )               &
+                                 -      (  5.0_wp * ibit29 * adv_mom_5            &
+                                     +              ibit28 * adv_mom_3            &
+                                        ) *                                    &
+                                     ( w(k,j,i+1) - w(k,j,i-2) )               &
+                                 +      (           ibit29 * adv_mom_5            &
+                                        ) *                                    &
+                                     ( w(k,j,i+2) - w(k,j,i-3) )               &
+                                                            )
+
+                ibit27 = IBITS(wall_flags_0(k,j,i),27,1)
+                ibit28 = IBITS(wall_flags_0(k,j,i),28,1)
+                ibit29 = IBITS(wall_flags_0(k,j,i),29,1)
+
+                u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
+                flux_r    = u_comp * (                                       &
+                          ( 37.0_wp * ibit29 * adv_mom_5                        &
+                       +     7.0_wp * ibit28 * adv_mom_3                        &
+                       +              ibit27 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( w(k,j,i+1) + w(k,j,i)   )                 &
+                   -      (  8.0_wp * ibit29 * adv_mom_5                        &
+                       +              ibit28 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( w(k,j,i+2) + w(k,j,i-1) )                 &
+                   +      (           ibit29 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( w(k,j,i+3) + w(k,j,i-2) )                 &
+                                     )
+
+                diss_r    = - ABS( u_comp ) * (                              &
+                          ( 10.0_wp * ibit29 * adv_mom_5                        &
+                       +     3.0_wp * ibit28 * adv_mom_3                        &
+                       +              ibit27 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( w(k,j,i+1) - w(k,j,i)  )                  &
+                   -      (  5.0_wp * ibit29 * adv_mom_5                        &
+                       +              ibit28 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( w(k,j,i+2) - w(k,j,i-1) )                 &
+                   +      (           ibit29 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( w(k,j,i+3) - w(k,j,i-2) )                 &
+                                              )
+                ibit32 = IBITS(wall_flags_00(k,j-1,i),0,1)
+                ibit31 = IBITS(wall_flags_0(k,j-1,i),31,1)
+                ibit30 = IBITS(wall_flags_0(k,j-1,i),30,1)
+
+                v_comp_s               = v(k+1,j,i) + v(k,j,i) - gv
+                flux_s                 = v_comp_s * (                         &
+                                    ( 37.0_wp * ibit32 * adv_mom_5               &
+                                 +     7.0_wp * ibit31 * adv_mom_3               &
+                                 +              ibit30 * adv_mom_1               &
+                                    ) *                                       &
+                                     ( w(k,j,i)   + w(k,j-1,i) )              &
+                             -      (  8.0_wp * ibit32 * adv_mom_5               &
+                                 +              ibit31 * adv_mom_3               &
+                                    ) *                                       &
+                                     ( w(k,j+1,i) + w(k,j-2,i) )              &
+                             +      (           ibit32 * adv_mom_5               &
+                                    ) *                                       &
+                                     ( w(k,j+2,i) + w(k,j-3,i) )              &
+                                               )
+
+                diss_s                 = - ABS( v_comp_s ) * (                &
+                                    ( 10.0_wp * ibit32 * adv_mom_5               &
+                                 +     3.0_wp * ibit31 * adv_mom_3               &
+                                 +              ibit30 * adv_mom_1               &
+                                    ) *                                       &
+                                     ( w(k,j,i)   - w(k,j-1,i) )              &
+                             -      (  5.0_wp * ibit32 * adv_mom_5               &
+                                 +              ibit31 * adv_mom_3               &
+                                    ) *                                       &
+                                     ( w(k,j+1,i) - w(k,j-2,i) )              &
+                             +      (           ibit32 * adv_mom_5               &
+                                    ) *                                       &
+                                     ( w(k,j+2,i) - w(k,j-3,i) )              &
+                                                        )
+
+                ibit32 = IBITS(wall_flags_00(k,j,i),0,1)
+                ibit31 = IBITS(wall_flags_0(k,j,i),31,1)
+                ibit30 = IBITS(wall_flags_0(k,j,i),30,1)
+
+                v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
+                flux_n    = v_comp * (                                       &
+                          ( 37.0_wp * ibit32 * adv_mom_5                        &
+                       +     7.0_wp * ibit31 * adv_mom_3                        &
+                       +              ibit30 * adv_mom_1                        &
+                          ) *                                                 &
+                                 ( w(k,j+1,i) + w(k,j,i)   )                 &
+                   -      (  8.0_wp * ibit32 * adv_mom_5                        &
+                       +              ibit31 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( w(k,j+2,i) + w(k,j-1,i) )                 &
+                   +      (           ibit32 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( w(k,j+3,i) + w(k,j-2,i) )                 &
+                                     )
+
+                diss_n    = - ABS( v_comp ) * (                              &
+                          ( 10.0_wp * ibit32 * adv_mom_5                        &
+                       +     3.0_wp * ibit31 * adv_mom_3                        &
+                       +              ibit30 * adv_mom_1                        &
+                          ) *                                                &
+                                 ( w(k,j+1,i) - w(k,j,i)  )                  &
+                   -      (  5.0_wp * ibit32 * adv_mom_5                        &
+                       +              ibit31 * adv_mom_3                        &
+                          ) *                                                &
+                                 ( w(k,j+2,i) - w(k,j-1,i) )                 &
+                   +      (           ibit32 * adv_mom_5                        &
+                          ) *                                                &
+                                 ( w(k,j+3,i) - w(k,j-2,i) )                 &
+                                              )
+
+                ibit35 = IBITS(wall_flags_00(k-1,j,i),3,1)
+                ibit34 = IBITS(wall_flags_00(k-1,j,i),2,1)
+                ibit33 = IBITS(wall_flags_00(k-1,j,i),1,1)
+
+                k_pp  = k + 2 * ibit35
+                k_mm  = k - 2 * ( ibit34 + ibit35 )
+                k_mmm = k - 3 * ibit35
+
+                w_comp    = w(k,j,i) + w(k-1,j,i)
+                flux_d    = w_comp  * (                                      &
+                          ( 37.0_wp * ibit35 * adv_mom_5                        &
+                       +     7.0_wp * ibit34 * adv_mom_3                        &
+                       +              ibit33 * adv_mom_1                        &
+                          ) *                                                &
+                             ( w(k,j,i)    + w(k-1,j,i)   )                  &
+                   -      (  8.0_wp * ibit35 * adv_mom_5                        &
+                       +              ibit34 * adv_mom_3                        &
+                          ) *                                                &
+                             ( w(k+1,j,i)  + w(k_mm,j,i)  )                  &
+                   +      (           ibit35 * adv_mom_5                        &
+                          ) *                                                &
+                             ( w(k_pp,j,i) + w(k_mmm,j,i) )                  &
+                                       )
+
+                diss_d    = - ABS( w_comp ) * (                              &
+                          ( 10.0_wp * ibit35 * adv_mom_5                        &
+                       +     3.0_wp * ibit34 * adv_mom_3                        &
+                       +              ibit33 * adv_mom_1                        &
+                          ) *                                                &
+                             ( w(k,j,i)    - w(k-1,j,i)   )                  &
+                   -      (  5.0_wp * ibit35 * adv_mom_5                        &
+                       +              ibit34 * adv_mom_3                        &
+                          ) *                                                &
+                             ( w(k+1,j,i)  - w(k_mm,j,i)  )                  &
+                   +      (           ibit35 * adv_mom_5                        &
+                          ) *                                                &
+                             ( w(k_pp,j,i) - w(k_mmm,j,i) )                  &
+                                               )
+
+!
+!--             k index has to be modified near bottom and top, else array
+!--             subscripts will be exceeded.
+                ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
+                ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
+                ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
+
+                k_ppp = k + 3 * ibit35
+                k_pp  = k + 2 * ( 1 - ibit33  )
+                k_mm  = k - 2 * ibit35
+
+                w_comp    = w(k+1,j,i) + w(k,j,i)
+                flux_t    = w_comp  * (                                      &
+                          ( 37.0_wp * ibit35 * adv_mom_5                        &
+                       +     7.0_wp * ibit34 * adv_mom_3                        &
+                       +              ibit33 * adv_mom_1                        &
+                          ) *                                                &
+                             ( w(k+1,j,i)  + w(k,j,i)     )                  &
+                   -      (  8.0_wp * ibit35 * adv_mom_5                        &
+                       +              ibit34 * adv_mom_3                        &
+                          ) *                                                &
+                             ( w(k_pp,j,i)  + w(k-1,j,i)  )                  &
+                   +      (           ibit35 * adv_mom_5                        &
+                          ) *                                                &
+                             ( w(k_ppp,j,i) + w(k_mm,j,i) )                  &
+                                       )
+
+                diss_t    = - ABS( w_comp ) * (                              &
+                          ( 10.0_wp * ibit35 * adv_mom_5                        &
+                       +     3.0_wp * ibit34 * adv_mom_3                        &
+                       +              ibit33 * adv_mom_1                        &
+                          ) *                                                &
+                             ( w(k+1,j,i)   - w(k,j,i)    )                  &
+                   -      (  5.0_wp * ibit35 * adv_mom_5                        &
+                       +              ibit34 * adv_mom_3                        &
+                          ) *                                                &
+                             ( w(k_pp,j,i)  - w(k-1,j,i)  )                  &
+                   +      (           ibit35 * adv_mom_5                        &
+                          ) *                                                &
+                             ( w(k_ppp,j,i) - w(k_mm,j,i) )                  &
+                                               )
+!
+!--             Calculate the divergence of the velocity field. A respective
+!--             correction is needed to overcome numerical instabilities caused
+!--             by a not sufficient reduction of divergences near topography.
+                div = ( ( ( u_comp + gu ) * ( ibit27 + ibit28 + ibit29 )      &
+                  - ( u(k+1,j,i) + u(k,j,i)   )                               & 
+                                    * ( IBITS(wall_flags_0(k,j,i-1),27,1)     &
+                                      + IBITS(wall_flags_0(k,j,i-1),28,1)     &
+                                      + IBITS(wall_flags_0(k,j,i-1),29,1)     &
+                                      )                                       &
+                  ) * ddx                                                     &
+              +   ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 )            & 
+                  - ( v(k+1,j,i) + v(k,j,i)   )                               &
+                                    * ( IBITS(wall_flags_0(k,j-1,i),30,1)     &
+                                      + IBITS(wall_flags_0(k,j-1,i),31,1)     &
+                                      + IBITS(wall_flags_00(k,j-1,i),0,1)     &
+                                      )                                       &
+                  ) * ddy                                                     &
+              +   ( w_comp          * ( ibit33 + ibit34 + ibit35 )            &
+                - ( w(k,j,i)   + w(k-1,j,i)   )                               &
+                                    * ( IBITS(wall_flags_00(k-1,j,i),1,1)     &
+                                      + IBITS(wall_flags_00(k-1,j,i),2,1)     &
+                                      + IBITS(wall_flags_00(k-1,j,i),3,1)     &
+                                      )                                       & 
+                  ) * ddzu(k+1)   &
+                ) * 0.5_wp
+
+
+                tend(k,j,i) = - (                                                &
+                               ( flux_r + diss_r - flux_l - diss_l ) * ddx       &
+                             + ( flux_n + diss_n - flux_s - diss_s ) * ddy       &
+                             + ( flux_t + diss_t - flux_d - diss_d ) * ddzu(k+1) &
+                                 ) + div * w(k,j,i)
+
+
+!++
+!--             Statistical Evaluation of w'w'.
+!                sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                    &
+!                               + ( flux_t + diss_t )                    &
+!                               *   weight_substep(intermediate_timestep_count)
+
+             ENDDO
+          ENDDO
+       ENDDO
+       !$acc end kernels
+
+    END SUBROUTINE advec_w_ws_acc
+
+ END MODULE advec_ws
Index: lm/trunk/SOURCE/advec_ws_mod.f90
===================================================================
--- /palm/trunk/SOURCE/advec_ws_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,6444 +1,0 @@
-!> @file advec_ws_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$ 
-! 
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-!
-! 
-! 1822 2016-04-07 07:49:42Z hoffmann
-! icloud_scheme removed, microphysics_seifert added
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1630 2015-08-26 16:57:23Z suehring
-! 
-! 
-! 1629 2015-08-26 16:56:11Z suehring
-! Bugfix concerning wall_flags at left and south PE boundaries
-!
-! 1581 2015-04-10 13:45:59Z suehring
-! 
-! 
-! 1580 2015-04-10 13:43:49Z suehring
-! Bugfix: statistical evaluation of scalar fluxes in case of monotonic limiter
-!
-! 1567 2015-03-10 17:57:55Z suehring
-! Bugfixes in monotonic limiter.
-!
-! 2015-03-09 13:10:37Z heinze
-! Bugfix: REAL constants provided with KIND-attribute in call of 
-! intrinsic functions like MAX and MIN 
-! 
-! 1557 2015-03-05 16:43:04Z suehring
-! Enable monotone advection for scalars using monotonic limiter
-!
-! 1374 2014-04-25 12:55:07Z raasch
-! missing variables added to ONLY list
-! 
-! 1361 2014-04-16 15:17:48Z hoffmann
-! accelerator and vector version for qr and nr added
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute,
-! module kinds added
-! some formatting adjustments
-!
-! 1322 2014-03-20 16:38:49Z raasch
-! REAL constants defined as wp-kind
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! old module precision_kind is removed,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1257 2013-11-08 15:18:40Z raasch
-! accelerator loop directives removed
-!
-! 1221 2013-09-10 08:59:13Z raasch
-! wall_flags_00 introduced, which holds bits 32-...
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1115 2013-03-26 18:16:16Z hoffmann
-! calculation of qr and nr is restricted to precipitation
-!
-! 1053 2012-11-13 17:11:03Z hoffmann
-! necessary expansions according to the two new prognostic equations (nr, qr) 
-! of the two-moment cloud physics scheme:
-! +flux_l_*, flux_s_*, diss_l_*, diss_s_*, sums_ws*s_ws_l 
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1027 2012-10-15 17:18:39Z suehring
-! Bugfix in calculation indices k_mm, k_pp in accelerator version
-!
-! 1019 2012-09-28 06:46:45Z raasch
-! small change in comment lines
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! accelerator versions (*_acc) added
-!
-! 1010 2012-09-20 07:59:54Z raasch
-! cpp switch __nopointer added for pointer free version
-!
-! 888 2012-04-20 15:03:46Z suehring
-! Number of IBITS() calls with identical arguments is reduced.
-!
-! 862 2012-03-26 14:21:38Z suehring
-! ws-scheme also work with topography in combination with vector version.
-! ws-scheme also work with outflow boundaries in combination with
-! vector version.
-! Degradation of the applied order of scheme is now steered by multiplying with
-! Integer wall_flags_0. 2nd order scheme, WS3 and WS5 are calculated on each
-! grid point and mulitplied with the appropriate flag.
-! 2nd order numerical dissipation term changed. Now the appropriate 2nd order
-! term derived according to the 4th and 6th order terms is applied. It turns
-! out that diss_2nd does not provide sufficient dissipation near walls.
-! Therefore, the function diss_2nd is removed.
-! Near walls a divergence correction is necessary to overcome numerical
-! instabilities due to too less divergence reduction of the velocity field.
-! boundary_flags and logicals steering the degradation are removed.
-! Empty SUBROUTINE local_diss removed.
-! Further formatting adjustments.
-!
-! 801 2012-01-10 17:30:36Z suehring
-! Bugfix concerning OpenMP parallelization. Summation of sums_wsus_ws_l,
-! sums_wsvs_ws_l, sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wspts_ws_l,
-! sums_wsqs_ws_l, sums_wssas_ws_l is now thread-safe by adding an additional
-! dimension.
-!
-! Initial revision
-!
-! 411 2009-12-11 12:31:43 Z suehring
-!
-! Description:
-! ------------
-!> Advection scheme for scalars and momentum using the flux formulation of
-!> Wicker and Skamarock 5th order. Additionally the module contains of a 
-!> routine using for initialisation and steering of the statical evaluation. 
-!> The computation of turbulent fluxes takes place inside the advection
-!> routines.
-!> Near non-cyclic boundaries the order of the applied advection scheme is
-!> degraded.
-!> A divergence correction is applied. It is necessary for topography, since
-!> the divergence is not sufficiently reduced, resulting in erroneous fluxes and
-!> partly numerical instabilities. 
-!-----------------------------------------------------------------------------!
- MODULE advec_ws
-
- 
-
-    PRIVATE
-    PUBLIC   advec_s_ws, advec_s_ws_acc, advec_u_ws, advec_u_ws_acc,          &
-             advec_v_ws, advec_v_ws_acc, advec_w_ws, advec_w_ws_acc,          &
-             ws_init, ws_statistics
-
-    INTERFACE ws_init
-       MODULE PROCEDURE ws_init
-    END INTERFACE ws_init
-
-    INTERFACE ws_statistics
-       MODULE PROCEDURE ws_statistics
-    END INTERFACE ws_statistics
-
-    INTERFACE advec_s_ws
-       MODULE PROCEDURE advec_s_ws
-       MODULE PROCEDURE advec_s_ws_ij
-    END INTERFACE advec_s_ws
-
-    INTERFACE advec_u_ws
-       MODULE PROCEDURE advec_u_ws
-       MODULE PROCEDURE advec_u_ws_ij
-    END INTERFACE advec_u_ws
-
-    INTERFACE advec_u_ws_acc
-       MODULE PROCEDURE advec_u_ws_acc
-    END INTERFACE advec_u_ws_acc
-
-    INTERFACE advec_v_ws
-       MODULE PROCEDURE advec_v_ws
-       MODULE PROCEDURE advec_v_ws_ij
-    END INTERFACE advec_v_ws
-
-    INTERFACE advec_v_ws_acc
-       MODULE PROCEDURE advec_v_ws_acc
-    END INTERFACE advec_v_ws_acc
-
-    INTERFACE advec_w_ws
-       MODULE PROCEDURE advec_w_ws
-       MODULE PROCEDURE advec_w_ws_ij
-    END INTERFACE advec_w_ws
-
-    INTERFACE advec_w_ws_acc
-       MODULE PROCEDURE advec_w_ws_acc
-    END INTERFACE advec_w_ws_acc
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of WS-scheme
-!------------------------------------------------------------------------------!
-    SUBROUTINE ws_init
-
-       USE arrays_3d,                                                          &
-           ONLY:  diss_l_e, diss_l_nr, diss_l_pt, diss_l_q, diss_l_qr,         &
-                  diss_l_sa, diss_l_u, diss_l_v, diss_l_w,  flux_l_e,          &
-                  flux_l_nr, flux_l_pt, flux_l_q, flux_l_qr, flux_l_sa,        &
-                  flux_l_u, flux_l_v, flux_l_w, diss_s_e, diss_s_nr, diss_s_pt,&
-                  diss_s_q, diss_s_qr, diss_s_sa, diss_s_u, diss_s_v, diss_s_w,& 
-                  flux_s_e, flux_s_nr, flux_s_pt, flux_s_q, flux_s_qr,         &
-                  flux_s_sa, flux_s_u, flux_s_v, flux_s_w
-
-       USE constants,                                                          &
-           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5, adv_sca_1, adv_sca_3,       &
-                  adv_sca_5
-
-       USE control_parameters,                                                 &
-           ONLY:  cloud_physics, humidity, loop_optimization,                  &
-                  monotonic_adjustment, passive_scalar, microphysics_seifert,  &
-                  ocean, ws_scheme_mom, ws_scheme_sca
-
-       USE indices,                                                            &
-           ONLY:  nyn, nys, nzb, nzt
-
-       USE kinds
-       
-       USE pegrid
-
-       USE statistics,                                                         &
-           ONLY:  sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wsnrs_ws_l,&
-                  sums_wspts_ws_l, sums_wsqrs_ws_l, sums_wsqs_ws_l,            &
-                  sums_wssas_ws_l,  sums_wsus_ws_l, sums_wsvs_ws_l  
-
-!
-!--    Set the appropriate factors for scalar and momentum advection.
-       adv_sca_5 = 1.0_wp /  60.0_wp
-       adv_sca_3 = 1.0_wp /  12.0_wp
-       adv_sca_1 = 1.0_wp /   2.0_wp
-       adv_mom_5 = 1.0_wp / 120.0_wp
-       adv_mom_3 = 1.0_wp /  24.0_wp
-       adv_mom_1 = 1.0_wp /   4.0_wp
-!         
-!--    Arrays needed for statical evaluation of fluxes.
-       IF ( ws_scheme_mom )  THEN
-
-          ALLOCATE( sums_wsus_ws_l(nzb:nzt+1,0:threads_per_task-1),            &
-                    sums_wsvs_ws_l(nzb:nzt+1,0:threads_per_task-1),            &
-                    sums_us2_ws_l(nzb:nzt+1,0:threads_per_task-1),             &
-                    sums_vs2_ws_l(nzb:nzt+1,0:threads_per_task-1),             &
-                    sums_ws2_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-
-          sums_wsus_ws_l = 0.0_wp
-          sums_wsvs_ws_l = 0.0_wp
-          sums_us2_ws_l  = 0.0_wp
-          sums_vs2_ws_l  = 0.0_wp
-          sums_ws2_ws_l  = 0.0_wp
-
-       ENDIF
-
-       IF ( ws_scheme_sca )  THEN
-
-          ALLOCATE( sums_wspts_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-          sums_wspts_ws_l = 0.0_wp
-
-          IF ( humidity  .OR.  passive_scalar )  THEN
-             ALLOCATE( sums_wsqs_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-             sums_wsqs_ws_l = 0.0_wp
-          ENDIF
-
-          IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
-             ALLOCATE( sums_wsqrs_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-             ALLOCATE( sums_wsnrs_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-             sums_wsqrs_ws_l = 0.0_wp
-             sums_wsnrs_ws_l = 0.0_wp
-          ENDIF
-
-          IF ( ocean )  THEN
-             ALLOCATE( sums_wssas_ws_l(nzb:nzt+1,0:threads_per_task-1) )
-             sums_wssas_ws_l = 0.0_wp
-          ENDIF
-
-       ENDIF
-
-!
-!--    Arrays needed for reasons of speed optimization for cache version.
-!--    For the vector version the buffer arrays are not necessary,
-!--    because the the fluxes can swapped directly inside the loops of the 
-!--    advection routines.
-       IF ( loop_optimization /= 'vector' )  THEN
-
-          IF ( ws_scheme_mom )  THEN
-
-             ALLOCATE( flux_s_u(nzb+1:nzt,0:threads_per_task-1),               &
-                       flux_s_v(nzb+1:nzt,0:threads_per_task-1),               &
-                       flux_s_w(nzb+1:nzt,0:threads_per_task-1),               &
-                       diss_s_u(nzb+1:nzt,0:threads_per_task-1),               &
-                       diss_s_v(nzb+1:nzt,0:threads_per_task-1),               &
-                       diss_s_w(nzb+1:nzt,0:threads_per_task-1) )
-             ALLOCATE( flux_l_u(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
-                       flux_l_v(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
-                       flux_l_w(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
-                       diss_l_u(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
-                       diss_l_v(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
-                       diss_l_w(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
-
-          ENDIF
-
-          IF ( ws_scheme_sca )  THEN
-
-             ALLOCATE( flux_s_pt(nzb+1:nzt,0:threads_per_task-1),              &
-                       flux_s_e(nzb+1:nzt,0:threads_per_task-1),               &
-                       diss_s_pt(nzb+1:nzt,0:threads_per_task-1),              &
-                       diss_s_e(nzb+1:nzt,0:threads_per_task-1) ) 
-             ALLOCATE( flux_l_pt(nzb+1:nzt,nys:nyn,0:threads_per_task-1),      &
-                       flux_l_e(nzb+1:nzt,nys:nyn,0:threads_per_task-1),       &
-                       diss_l_pt(nzb+1:nzt,nys:nyn,0:threads_per_task-1),      &
-                       diss_l_e(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
-
-             IF ( humidity  .OR.  passive_scalar )  THEN
-                ALLOCATE( flux_s_q(nzb+1:nzt,0:threads_per_task-1),            &
-                          diss_s_q(nzb+1:nzt,0:threads_per_task-1) )
-                ALLOCATE( flux_l_q(nzb+1:nzt,nys:nyn,0:threads_per_task-1),    &
-                          diss_l_q(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
-             ENDIF
-
-             IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
-                ALLOCATE( flux_s_qr(nzb+1:nzt,0:threads_per_task-1),           &
-                          diss_s_qr(nzb+1:nzt,0:threads_per_task-1),           &
-                          flux_s_nr(nzb+1:nzt,0:threads_per_task-1),           &
-                          diss_s_nr(nzb+1:nzt,0:threads_per_task-1) )
-                ALLOCATE( flux_l_qr(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
-                          diss_l_qr(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
-                          flux_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
-                          diss_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 
-             ENDIF
-
-             IF ( ocean )  THEN
-                ALLOCATE( flux_s_sa(nzb+1:nzt,0:threads_per_task-1),           &
-                          diss_s_sa(nzb+1:nzt,0:threads_per_task-1) )
-                ALLOCATE( flux_l_sa(nzb+1:nzt,nys:nyn,0:threads_per_task-1),   &
-                          diss_l_sa(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
-             ENDIF
-
-          ENDIF
-
-       ENDIF
-
-    END SUBROUTINE ws_init
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialize variables used for storing statistic quantities (fluxes, variances)
-!------------------------------------------------------------------------------!
-    SUBROUTINE ws_statistics
-    
-       USE control_parameters,                                                 &
-           ONLY:  cloud_physics, humidity, passive_scalar, ocean,              &
-                  microphysics_seifert, ws_scheme_mom, ws_scheme_sca
-
-       USE kinds
-
-       USE statistics,                                                         &
-           ONLY:  sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wsnrs_ws_l,&
-                  sums_wspts_ws_l, sums_wsqrs_ws_l, sums_wsqs_ws_l,            &
-                  sums_wssas_ws_l,  sums_wsus_ws_l, sums_wsvs_ws_l  
-
-       IMPLICIT NONE
-
-!       
-!--    The arrays needed for statistical evaluation are set to to 0 at the 
-!--    beginning of prognostic_equations.
-       IF ( ws_scheme_mom )  THEN
-          sums_wsus_ws_l = 0.0_wp
-          sums_wsvs_ws_l = 0.0_wp
-          sums_us2_ws_l  = 0.0_wp
-          sums_vs2_ws_l  = 0.0_wp
-          sums_ws2_ws_l  = 0.0_wp
-       ENDIF
-
-       IF ( ws_scheme_sca )  THEN
-          sums_wspts_ws_l = 0.0_wp
-          IF ( humidity  .OR.  passive_scalar )  sums_wsqs_ws_l = 0.0_wp
-          IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
-             sums_wsqrs_ws_l = 0.0_wp
-             sums_wsnrs_ws_l = 0.0_wp
-          ENDIF
-          IF ( ocean )  sums_wssas_ws_l = 0.0_wp
-
-       ENDIF
-
-    END SUBROUTINE ws_statistics
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Scalar advection - Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_s_ws_ij( i, j, sk, sk_char, swap_flux_y_local,            &
-                              swap_diss_y_local, swap_flux_x_local,            &
-                              swap_diss_x_local, i_omp, tn )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE constants,                                                          &
-           ONLY:  adv_sca_1, adv_sca_3, adv_sca_5
-
-       USE control_parameters,                                                 &
-           ONLY:  intermediate_timestep_count, monotonic_adjustment, u_gtrans, &
-                  v_gtrans 
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max,    &
-                  nzt, wall_flags_0
-
-       USE kinds
-
-       USE pegrid
-
-       USE statistics,                                                         &
-           ONLY:  sums_wsnrs_ws_l, sums_wspts_ws_l, sums_wsqrs_ws_l,           &
-                  sums_wsqs_ws_l, sums_wssas_ws_l, weight_substep
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN = *), INTENT(IN) ::  sk_char !<
-       
-       INTEGER(iwp) ::  i     !<
-       INTEGER(iwp) ::  ibit0 !<
-       INTEGER(iwp) ::  ibit1 !<
-       INTEGER(iwp) ::  ibit2 !<
-       INTEGER(iwp) ::  ibit3 !<
-       INTEGER(iwp) ::  ibit4 !<
-       INTEGER(iwp) ::  ibit5 !<
-       INTEGER(iwp) ::  ibit6 !<
-       INTEGER(iwp) ::  ibit7 !<
-       INTEGER(iwp) ::  ibit8 !<
-       INTEGER(iwp) ::  i_omp !<
-       INTEGER(iwp) ::  j     !<
-       INTEGER(iwp) ::  k     !<
-       INTEGER(iwp) ::  k_mm  !<
-       INTEGER(iwp) ::  k_mmm !<
-       INTEGER(iwp) ::  k_pp  !<
-       INTEGER(iwp) ::  k_ppp !<
-       INTEGER(iwp) ::  tn    !<
-       
-       REAL(wp)     ::  diss_d !<
-       REAL(wp)     ::  div    !<
-       REAL(wp)     ::  flux_d !<
-       REAL(wp)     ::  fd_1   !<
-       REAL(wp)     ::  fl_1   !<
-       REAL(wp)     ::  fn_1   !<
-       REAL(wp)     ::  fr_1   !<
-       REAL(wp)     ::  fs_1   !<
-       REAL(wp)     ::  ft_1   !<
-       REAL(wp)     ::  phi_d  !<
-       REAL(wp)     ::  phi_l  !<
-       REAL(wp)     ::  phi_n  !<
-       REAL(wp)     ::  phi_r  !<
-       REAL(wp)     ::  phi_s  !<
-       REAL(wp)     ::  phi_t  !<
-       REAL(wp)     ::  rd     !<
-       REAL(wp)     ::  rl     !<
-       REAL(wp)     ::  rn     !<
-       REAL(wp)     ::  rr     !<
-       REAL(wp)     ::  rs     !<
-       REAL(wp)     ::  rt     !<
-       REAL(wp)     ::  u_comp !<
-       REAL(wp)     ::  v_comp !<
-       
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER    ::  sk     !<
-#endif
-       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_n !<
-       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_r !<
-       REAL(wp), DIMENSION(nzb:nzt+1)         ::  diss_t !<
-       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_n !<
-       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_r !<
-       REAL(wp), DIMENSION(nzb:nzt+1)         ::  flux_t !<
-       
-       REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_diss_y_local !<
-       REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) ::  swap_flux_y_local !<
-       
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_diss_x_local !<
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ::  swap_flux_x_local !<
-       
-
-!
-!--    Compute southside fluxes of the respective PE bounds.
-       IF ( j == nys )  THEN
-!
-!--       Up to the top of the highest topography.
-          DO  k = nzb+1, nzb_max
-
-             ibit5 = IBITS(wall_flags_0(k,j-1,i),5,1)
-             ibit4 = IBITS(wall_flags_0(k,j-1,i),4,1)
-             ibit3 = IBITS(wall_flags_0(k,j-1,i),3,1)
-
-             v_comp                  = v(k,j,i) - v_gtrans
-             swap_flux_y_local(k,tn) = v_comp *         (                     &
-                                               ( 37.0_wp * ibit5 * adv_sca_5  &
-                                            +     7.0_wp * ibit4 * adv_sca_3  &
-                                            +              ibit3 * adv_sca_1  &
-                                               ) *                            &
-                                           ( sk(k,j,i)  + sk(k,j-1,i)     )   &
-                                         -     (  8.0_wp * ibit5 * adv_sca_5  &
-                                            +              ibit4 * adv_sca_3  &
-                                                ) *                           &
-                                           ( sk(k,j+1,i) + sk(k,j-2,i)    )   &
-                                         +     (           ibit5 * adv_sca_5  &
-                                               ) *                            &
-                                           ( sk(k,j+2,i) + sk(k,j-3,i)    )   &
-                                                        )
-
-             swap_diss_y_local(k,tn) = -ABS( v_comp ) * (                     &
-                                               ( 10.0_wp * ibit5 * adv_sca_5  &
-                                            +     3.0_wp * ibit4 * adv_sca_3  &
-                                            +              ibit3 * adv_sca_1  &
-                                               ) *                            &
-                                            ( sk(k,j,i)   - sk(k,j-1,i)  )    &
-                                        -      (  5.0_wp * ibit5 * adv_sca_5  &
-                                            +              ibit4 * adv_sca_3  &
-                                            ) *                               &
-                                            ( sk(k,j+1,i) - sk(k,j-2,i)  )    &
-                                        +      (           ibit5 * adv_sca_5  &
-                                               ) *                            &
-                                            ( sk(k,j+2,i) - sk(k,j-3,i)  )    &
-                                                        )
-
-          ENDDO
-!
-!--       Above to the top of the highest topography. No degradation necessary.
-          DO  k = nzb_max+1, nzt
-
-             v_comp                  = v(k,j,i) - v_gtrans
-             swap_flux_y_local(k,tn) = v_comp * (                             &
-                                    37.0_wp * ( sk(k,j,i)   + sk(k,j-1,i) )   &
-                                  -  8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) )   &
-                                  +           ( sk(k,j+2,i) + sk(k,j-3,i) )   &
-                                                ) * adv_sca_5
-              swap_diss_y_local(k,tn) = -ABS( v_comp ) * (                    &
-                                    10.0_wp * ( sk(k,j,i)   - sk(k,j-1,i) )   &
-                                  -  5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) )   &
-                                  +             sk(k,j+2,i) - sk(k,j-3,i)     &
-                                                         ) * adv_sca_5
-
-          ENDDO
-
-       ENDIF
-!
-!--    Compute leftside fluxes of the respective PE bounds.
-       IF ( i == i_omp )  THEN
-        
-          DO  k = nzb+1, nzb_max
-
-             ibit2 = IBITS(wall_flags_0(k,j,i-1),2,1)
-             ibit1 = IBITS(wall_flags_0(k,j,i-1),1,1)
-             ibit0 = IBITS(wall_flags_0(k,j,i-1),0,1)
-
-             u_comp                     = u(k,j,i) - u_gtrans
-             swap_flux_x_local(k,j,tn) = u_comp * (                           &
-                                               ( 37.0_wp * ibit2 * adv_sca_5  &
-                                            +     7.0_wp * ibit1 * adv_sca_3  &
-                                            +              ibit0 * adv_sca_1  &
-                                               ) *                            &
-                                            ( sk(k,j,i)   + sk(k,j,i-1)    )  &
-                                        -      (  8.0_wp * ibit2 * adv_sca_5  &
-                                            +              ibit1 * adv_sca_3  &
-                                               ) *                            &
-                                            ( sk(k,j,i+1) + sk(k,j,i-2)    )  &
-                                        +      (           ibit2 * adv_sca_5  &
-                                               ) *                            &
-                                            ( sk(k,j,i+2) + sk(k,j,i-3)    )  &
-                                                  )
-
-              swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * (                  &
-                                               ( 10.0_wp * ibit2 * adv_sca_5  &
-                                            +     3.0_wp * ibit1 * adv_sca_3  &
-                                            +              ibit0 * adv_sca_1  &
-                                               ) *                            &
-                                            ( sk(k,j,i)   - sk(k,j,i-1)    )  &
-                                        -      (  5.0_wp * ibit2 * adv_sca_5  &
-                                            +              ibit1 * adv_sca_3  &
-                                               ) *                            &
-                                            ( sk(k,j,i+1) - sk(k,j,i-2)    )  &
-                                        +      (           ibit2 * adv_sca_5  &
-                                               ) *                            &
-                                            ( sk(k,j,i+2) - sk(k,j,i-3)    )  &
-                                                           )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             u_comp                 = u(k,j,i) - u_gtrans
-             swap_flux_x_local(k,j,tn) = u_comp * (                           &
-                                      37.0_wp * ( sk(k,j,i)   + sk(k,j,i-1) ) &
-                                    -  8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) ) &
-                                    +           ( sk(k,j,i+2) + sk(k,j,i-3) ) &
-                                                  ) * adv_sca_5
-
-             swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * (                   &
-                                      10.0_wp * ( sk(k,j,i)   - sk(k,j,i-1) ) &
-                                    -  5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) ) &
-                                    +           ( sk(k,j,i+2) - sk(k,j,i-3) ) &
-                                                          ) * adv_sca_5
-
-          ENDDO
-           
-       ENDIF
-
-       flux_t(0) = 0.0_wp
-       diss_t(0) = 0.0_wp
-       flux_d    = 0.0_wp
-       diss_d    = 0.0_wp
-!        
-!--    Now compute the fluxes and tendency terms for the horizontal and
-!--    vertical parts up to the top of the highest topography.
-       DO  k = nzb+1, nzb_max
-!
-!--       Note: It is faster to conduct all multiplications explicitly, e.g.
-!--       * adv_sca_5 ... than to determine a factor and multiplicate the
-!--       flux at the end. 
-
-          ibit2 = IBITS(wall_flags_0(k,j,i),2,1)
-          ibit1 = IBITS(wall_flags_0(k,j,i),1,1)
-          ibit0 = IBITS(wall_flags_0(k,j,i),0,1)
-
-          u_comp    = u(k,j,i+1) - u_gtrans
-          flux_r(k) = u_comp * (                                              &
-                     ( 37.0_wp * ibit2 * adv_sca_5                            &
-                  +     7.0_wp * ibit1 * adv_sca_3                            &
-                  +              ibit0 * adv_sca_1                            &
-                     ) *                                                      &
-                             ( sk(k,j,i+1) + sk(k,j,i)   )                    &
-              -      (  8.0_wp * ibit2 * adv_sca_5                            &
-                  +              ibit1 * adv_sca_3                            &
-                     ) *                                                      &
-                             ( sk(k,j,i+2) + sk(k,j,i-1) )                    &
-              +      (           ibit2 * adv_sca_5                            &
-                     ) *                                                      &
-                             ( sk(k,j,i+3) + sk(k,j,i-2) )                    &
-                               )
-
-          diss_r(k) = -ABS( u_comp ) * (                                      &
-                     ( 10.0_wp * ibit2 * adv_sca_5                            &
-                  +     3.0_wp * ibit1 * adv_sca_3                            &
-                  +              ibit0 * adv_sca_1                            &
-                     ) *                                                      &
-                             ( sk(k,j,i+1) - sk(k,j,i)  )                     &
-              -      (  5.0_wp * ibit2 * adv_sca_5                            &
-                  +              ibit1 * adv_sca_3                            &
-                     ) *                                                      &
-                             ( sk(k,j,i+2) - sk(k,j,i-1) )                    &
-              +      (           ibit2 * adv_sca_5                            &
-                     ) *                                                      &
-                             ( sk(k,j,i+3) - sk(k,j,i-2) )                    &
-                                       )
-
-          ibit5 = IBITS(wall_flags_0(k,j,i),5,1)
-          ibit4 = IBITS(wall_flags_0(k,j,i),4,1)
-          ibit3 = IBITS(wall_flags_0(k,j,i),3,1)
-
-          v_comp    = v(k,j+1,i) - v_gtrans
-          flux_n(k) = v_comp * (                                              &
-                     ( 37.0_wp * ibit5 * adv_sca_5                            &
-                  +     7.0_wp * ibit4 * adv_sca_3                            &
-                  +              ibit3 * adv_sca_1                            &
-                     ) *                                                      &
-                             ( sk(k,j+1,i) + sk(k,j,i)   )                    &
-              -      (  8.0_wp * ibit5 * adv_sca_5                            &
-                  +              ibit4 * adv_sca_3                            &
-                     ) *                                                      &
-                             ( sk(k,j+2,i) + sk(k,j-1,i) )                    &
-              +      (           ibit5 * adv_sca_5                            &
-                     ) *                                                      &
-                             ( sk(k,j+3,i) + sk(k,j-2,i) )                    &
-                               )
-
-          diss_n(k) = -ABS( v_comp ) * (                                      &
-                     ( 10.0_wp * ibit5 * adv_sca_5                            &
-                  +     3.0_wp * ibit4 * adv_sca_3                            &
-                  +              ibit3 * adv_sca_1                            &
-                     ) *                                                      &
-                             ( sk(k,j+1,i) - sk(k,j,i)   )                    &
-              -      (  5.0_wp * ibit5 * adv_sca_5                            &
-                  +              ibit4 * adv_sca_3                            &
-                     ) *                                                      &
-                             ( sk(k,j+2,i) - sk(k,j-1,i) )                    &
-              +      (           ibit5 * adv_sca_5                            &
-                     ) *                                                      &
-                             ( sk(k,j+3,i) - sk(k,j-2,i) )                    &
-                                       )
-!
-!--       k index has to be modified near bottom and top, else array
-!--       subscripts will be exceeded.
-          ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
-          ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
-          ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
-
-          k_ppp = k + 3 * ibit8
-          k_pp  = k + 2 * ( 1 - ibit6  )
-          k_mm  = k - 2 * ibit8
-
-
-          flux_t(k) = w(k,j,i) * (                                            &
-                     ( 37.0_wp * ibit8 * adv_sca_5                            &
-                  +     7.0_wp * ibit7 * adv_sca_3                            &
-                  +              ibit6 * adv_sca_1                            &
-                     ) *                                                      &
-                             ( sk(k+1,j,i)  + sk(k,j,i)    )                  &
-              -      (  8.0_wp * ibit8 * adv_sca_5                            &
-                  +              ibit7 * adv_sca_3                            &
-                     ) *                                                      &
-                             ( sk(k_pp,j,i) + sk(k-1,j,i)  )                  &
-              +      (           ibit8 * adv_sca_5                            &
-                     ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )                  &
-                                 )
-
-          diss_t(k) = -ABS( w(k,j,i) ) * (                                    &
-                     ( 10.0_wp * ibit8 * adv_sca_5                            &
-                  +     3.0_wp * ibit7 * adv_sca_3                            &
-                  +              ibit6 * adv_sca_1                            &
-                     ) *                                                      &
-                             ( sk(k+1,j,i)   - sk(k,j,i)    )                 &
-              -      (  5.0_wp * ibit8 * adv_sca_5                            &
-                  +              ibit7 * adv_sca_3                            &
-                     ) *                                                      &
-                             ( sk(k_pp,j,i)  - sk(k-1,j,i)  )                 &
-              +      (           ibit8 * adv_sca_5                            &
-                     ) *                                                      &
-                             ( sk(k_ppp,j,i) - sk(k_mm,j,i) )                 &
-                                         )
-!
-!--       Apply monotonic adjustment.
-          IF ( monotonic_adjustment )  THEN
-!
-!--          At first, calculate first order fluxes.
-             u_comp = u(k,j,i) - u_gtrans
-             fl_1   =  ( u_comp   * ( sk(k,j,i) + sk(k,j,i-1) )               &
-                   -ABS( u_comp ) * ( sk(k,j,i) - sk(k,j,i-1) )               &
-                       ) * adv_sca_1 
-
-             u_comp = u(k,j,i+1) - u_gtrans
-             fr_1   =  ( u_comp   * ( sk(k,j,i+1) + sk(k,j,i) )               &
-                   -ABS( u_comp ) * ( sk(k,j,i+1) - sk(k,j,i) )               &
-                       ) * adv_sca_1 
-
-             v_comp = v(k,j,i) - v_gtrans
-             fs_1   =  ( v_comp   * ( sk(k,j,i) + sk(k,j-1,i) )               &
-                   -ABS( v_comp ) * ( sk(k,j,i) - sk(k,j-1,i) )               &
-                       ) * adv_sca_1 
-
-             v_comp = v(k,j+1,i) - v_gtrans
-             fn_1   =  ( v_comp   * ( sk(k,j+1,i) + sk(k,j,i) )               &
-                   -ABS( v_comp ) * ( sk(k,j+1,i) - sk(k,j,i) )               &
-                       ) * adv_sca_1 
-
-             fd_1   =  ( w(k-1,j,i)   * ( sk(k,j,i) + sk(k-1,j,i) )           &
-                   -ABS( w(k-1,j,i) ) * ( sk(k,j,i) - sk(k-1,j,i) )           &
-                       ) * adv_sca_1 
-
-             ft_1   =  ( w(k,j,i)   * ( sk(k+1,j,i) + sk(k,j,i) )             &
-                   -ABS( w(k,j,i) ) * ( sk(k+1,j,i) - sk(k,j,i) )             &
-                      ) * adv_sca_1 
-!
-!--          Calculate ratio of upwind gradients. Note, Min/Max is just to 
-!--          avoid if statements.
-             rl     = ( MAX( 0.0_wp, u(k,j,i) - u_gtrans ) *                  & 
-                           ABS( ( sk(k,j,i-1) - sk(k,j,i-2)            ) /    &
-                                ( sk(k,j,i)   - sk(k,j,i-1) + 1E-20_wp )      &
-                              ) +                                             & 
-                        MIN( 0.0_wp, u(k,j,i) - u_gtrans ) *                  &
-                           ABS( ( sk(k,j,i)   - sk(k,j,i+1)            ) /    &
-                                ( sk(k,j,i-1) - sk(k,j,i)   + 1E-20_wp )      &
-                              )                                               &
-                      ) / ABS( u(k,j,i) - u_gtrans + 1E-20_wp )
-
-             rr     = ( MAX( 0.0_wp, u(k,j,i+1) - u_gtrans ) *                & 
-                           ABS( ( sk(k,j,i)   - sk(k,j,i-1)            ) /    &
-                                ( sk(k,j,i+1) - sk(k,j,i)   + 1E-20_wp )      &
-                              ) +                                             & 
-                        MIN( 0.0_wp, u(k,j,i+1) - u_gtrans ) *                &
-                           ABS( ( sk(k,j,i+1) - sk(k,j,i+2)            ) /    &
-                                ( sk(k,j,i)   - sk(k,j,i+1) + 1E-20_wp )      &
-                              )                                               &
-                      ) / ABS( u(k,j,i+1) - u_gtrans + 1E-20_wp )
-
-             rs     = ( MAX( 0.0_wp, v(k,j,i) - v_gtrans ) *                  & 
-                           ABS( ( sk(k,j-1,i) - sk(k,j-2,i)            ) /    &
-                                ( sk(k,j,i)   - sk(k,j-1,i) + 1E-20_wp )      &
-                              ) +                                             & 
-                        MIN( 0.0_wp, v(k,j,i) - v_gtrans ) *                  &
-                           ABS( ( sk(k,j,i)   - sk(k,j+1,i)            ) /    &
-                                ( sk(k,j-1,i) - sk(k,j,i)   + 1E-20_wp )      &
-                              )                                               &
-                      ) / ABS( v(k,j,i) - v_gtrans + 1E-20_wp )
-
-             rn     = ( MAX( 0.0_wp, v(k,j+1,i) - v_gtrans ) *                & 
-                           ABS( ( sk(k,j,i)   - sk(k,j-1,i)            ) /    &
-                                ( sk(k,j+1,i) - sk(k,j,i)   + 1E-20_wp )      &
-                              ) +                                             & 
-                       MIN( 0.0_wp, v(k,j+1,i) - v_gtrans ) *                 &
-                           ABS( ( sk(k,j+1,i) - sk(k,j+2,i)            ) /    &
-                                ( sk(k,j,i)   - sk(k,j+1,i) + 1E-20_wp )      &
-                              )                                               &
-                      ) / ABS( v(k,j+1,i) - v_gtrans + 1E-20_wp )     
-!   
-!--          Reuse k_mm and compute k_mmm for the vertical gradient ratios. 
-!--          Note, for vertical advection below the third grid point above 
-!--          surface ( or below the model top) rd and rt are set to 0, i.e. 
-!--          use of first order scheme is enforced.
-             k_mmm  = k - 3 * ibit8
-
-             rd     = ( MAX( 0.0_wp, w(k-1,j,i) ) *                           & 
-                           ABS( ( sk(k_mm,j,i) - sk(k_mmm,j,i)           ) /  &
-                                ( sk(k-1,j,i)  - sk(k_mm,j,i) + 1E-20_wp )    &
-                              ) +                                             & 
-                        MIN( 0.0_wp, w(k-1,j,i) ) *                           &
-                           ABS( ( sk(k-1,j,i) - sk(k,j,i)            ) /      &
-                                ( sk(k_mm,j,i) - sk(k-1,j,i)   + 1E-20_wp )   &
-                              )                                               &
-                      ) * ibit8 / ABS( w(k-1,j,i) + 1E-20_wp ) 
- 
-             rt     = ( MAX( 0.0_wp, w(k,j,i) ) *                             & 
-                           ABS( ( sk(k,j,i)   - sk(k-1,j,i)            ) /    &
-                                ( sk(k+1,j,i) - sk(k,j,i)   + 1E-20_wp )      &
-                              ) +                                             & 
-                        MIN( 0.0_wp, w(k,j,i) ) *                             &
-                           ABS( ( sk(k+1,j,i) - sk(k_pp,j,i)           ) /    &
-                                ( sk(k,j,i)   - sk(k+1,j,i) + 1E-20_wp )      &
-                              )                                               &
-                      ) * ibit8 / ABS( w(k,j,i) + 1E-20_wp )
-!
-!--           Calculate empirical limiter function (van Albada2 limiter).
-              phi_l = MIN( 1.0_wp, ( 2.0_wp * ABS( rl ) ) /                   &
-                                         ( rl**2 + 1.0_wp ) ) 
-              phi_r = MIN( 1.0_wp, ( 2.0_wp * ABS( rr ) ) /                   &
-                                         ( rr**2 + 1.0_wp ) ) 
-              phi_s = MIN( 1.0_wp, ( 2.0_wp * ABS( rs ) ) /                   &
-                                         ( rs**2 + 1.0_wp ) ) 
-              phi_n = MIN( 1.0_wp, ( 2.0_wp * ABS( rn ) ) /                   &
-                                         ( rn**2 + 1.0_wp ) ) 
-              phi_d = MIN( 1.0_wp, ( 2.0_wp * ABS( rd ) ) /                   &
-                                         ( rd**2 + 1.0_wp ) ) 
-              phi_t = MIN( 1.0_wp, ( 2.0_wp * ABS( rt ) ) /                   &
-                                         ( rt**2 + 1.0_wp ) ) 
-!
-!--           Calculate the resulting monotone flux. 
-              swap_flux_x_local(k,j,tn) = fl_1 - phi_l *                      &
-                                        ( fl_1 - swap_flux_x_local(k,j,tn)  )
-              flux_r(k)                 = fr_1 - phi_r *                      &
-                                        ( fr_1 - flux_r(k)                  )
-              swap_flux_y_local(k,tn)   = fs_1 - phi_s *                      &
-                                        ( fs_1 - swap_flux_y_local(k,tn)    )
-              flux_n(k)                 = fn_1 - phi_n *                      &
-                                        ( fn_1 - flux_n(k)                  )
-              flux_d                    = fd_1 - phi_d *                      &
-                                        ( fd_1 - flux_d                     )
-              flux_t(k)                 = ft_1 - phi_t *                      &
-                                        ( ft_1 - flux_t(k)                  )
-!
-!--          Moreover, modify dissipation flux according to the limiter. 
-             swap_diss_x_local(k,j,tn) = swap_diss_x_local(k,j,tn) * phi_l
-             diss_r(k)                 = diss_r(k)                 * phi_r
-             swap_diss_y_local(k,tn)   = swap_diss_y_local(k,tn)   * phi_s
-             diss_n(k)                 = diss_n(k)                 * phi_n
-             diss_d                    = diss_d                    * phi_d
-             diss_t(k)                 = diss_t(k)                 * phi_t
-
-          ENDIF
-!
-!--       Calculate the divergence of the velocity field. A respective
-!--       correction is needed to overcome numerical instabilities caused
-!--       by a not sufficient reduction of divergences near topography. 
-          div         =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )             &
-                          - u(k,j,i)   * ( IBITS(wall_flags_0(k,j,i-1),0,1)    &
-                                         + IBITS(wall_flags_0(k,j,i-1),1,1)    &
-                                         + IBITS(wall_flags_0(k,j,i-1),2,1)    &
-                                         )                                     &
-                          ) * ddx                                              &
-                        + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )             &
-                          - v(k,j,i)   * ( IBITS(wall_flags_0(k,j-1,i),3,1)    &
-                                         + IBITS(wall_flags_0(k,j-1,i),4,1)    &
-                                         + IBITS(wall_flags_0(k,j-1,i),5,1)    &
-                                         )                                     &
-                          ) * ddy                                              &
-                        + ( w(k,j,i)   * ( ibit6 + ibit7 + ibit8 )             &
-                          - w(k-1,j,i) * ( IBITS(wall_flags_0(k-1,j,i),6,1)    &
-                                         + IBITS(wall_flags_0(k-1,j,i),7,1)    &
-                                         + IBITS(wall_flags_0(k-1,j,i),8,1)    &
-                                         )                                     &      
-                          ) * ddzw(k)
-
-
-          tend(k,j,i) = tend(k,j,i) - (                                       &
-                        ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j,tn) - &
-                          swap_diss_x_local(k,j,tn)            ) * ddx        &
-                      + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k,tn)   - &
-                          swap_diss_y_local(k,tn)              ) * ddy        &
-                      + ( flux_t(k) + diss_t(k) - flux_d - diss_d             &
-                                                               ) * ddzw(k)    &
-                                      ) + sk(k,j,i) * div
-
-          swap_flux_y_local(k,tn)   = flux_n(k)
-          swap_diss_y_local(k,tn)   = diss_n(k)
-          swap_flux_x_local(k,j,tn) = flux_r(k)
-          swap_diss_x_local(k,j,tn) = diss_r(k)
-          flux_d                    = flux_t(k)
-          diss_d                    = diss_t(k)
-
-       ENDDO
-!
-!--    Now compute the fluxes and tendency terms for the horizontal and
-!--    vertical parts above the top of the highest topography. No degradation
-!--    for the horizontal parts, but for the vertical it is stell needed.
-       DO  k = nzb_max+1, nzt
-
-          u_comp    = u(k,j,i+1) - u_gtrans
-          flux_r(k) = u_comp * (                                              &
-                      37.0_wp * ( sk(k,j,i+1) + sk(k,j,i)   )                 &
-                    -  8.0_wp * ( sk(k,j,i+2) + sk(k,j,i-1) )                 &
-                    +           ( sk(k,j,i+3) + sk(k,j,i-2) ) ) * adv_sca_5
-          diss_r(k) = -ABS( u_comp ) * (                                      &
-                      10.0_wp * ( sk(k,j,i+1) - sk(k,j,i)   )                 &
-                    -  5.0_wp * ( sk(k,j,i+2) - sk(k,j,i-1) )                 &
-                    +           ( sk(k,j,i+3) - sk(k,j,i-2) ) ) * adv_sca_5
-
-          v_comp    = v(k,j+1,i) - v_gtrans
-          flux_n(k) = v_comp * (                                              &
-                      37.0_wp * ( sk(k,j+1,i) + sk(k,j,i)   )                 &
-                    -  8.0_wp * ( sk(k,j+2,i) + sk(k,j-1,i) )                 &
-                    +           ( sk(k,j+3,i) + sk(k,j-2,i) ) ) * adv_sca_5
-          diss_n(k) = -ABS( v_comp ) * (                                      &
-                      10.0_wp * ( sk(k,j+1,i) - sk(k,j,i)   )                 &
-                    -  5.0_wp * ( sk(k,j+2,i) - sk(k,j-1,i) )                 &
-                    +           ( sk(k,j+3,i) - sk(k,j-2,i) ) ) * adv_sca_5
-!
-!--       k index has to be modified near bottom and top, else array
-!--       subscripts will be exceeded.
-          ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
-          ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
-          ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
-
-          k_ppp = k + 3 * ibit8
-          k_pp  = k + 2 * ( 1 - ibit6  )
-          k_mm  = k - 2 * ibit8
-
-          flux_t(k) = w(k,j,i) * (                                            &
-                    ( 37.0_wp * ibit8 * adv_sca_5                             &
-                 +     7.0_wp * ibit7 * adv_sca_3                             &
-                 +              ibit6 * adv_sca_1                             &
-                    ) *                                                       &
-                             ( sk(k+1,j,i)  + sk(k,j,i)   )                   &
-              -     (  8.0_wp * ibit8 * adv_sca_5                             &
-                  +              ibit7 * adv_sca_3                            &
-                    ) *                                                       &
-                             ( sk(k_pp,j,i) + sk(k-1,j,i) )                   &
-              +     (           ibit8 * adv_sca_5                             &
-                    ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )                   &
-                                 )
-
-          diss_t(k) = -ABS( w(k,j,i) ) * (                                    &
-                    ( 10.0_wp * ibit8 * adv_sca_5                             &
-                 +     3.0_wp * ibit7 * adv_sca_3                             &
-                 +              ibit6 * adv_sca_1                             &
-                    ) *                                                       &
-                             ( sk(k+1,j,i)   - sk(k,j,i)    )                 &
-              -     (  5.0_wp * ibit8 * adv_sca_5                             &
-                 +              ibit7 * adv_sca_3                             &
-                    ) *                                                       &
-                             ( sk(k_pp,j,i)  - sk(k-1,j,i)  )                 &
-              +     (           ibit8 * adv_sca_5                             &
-                    ) *                                                       &
-                             ( sk(k_ppp,j,i) - sk(k_mm,j,i) )                 &
-                                         )
-
-
-!
-!--       Apply monotonic adjustment.
-          IF ( monotonic_adjustment )  THEN
-!
-!--          At first, calculate first order fluxes.
-             u_comp = u(k,j,i) - u_gtrans
-             fl_1   =  ( u_comp   * ( sk(k,j,i) + sk(k,j,i-1) )               &
-                   -ABS( u_comp ) * ( sk(k,j,i) - sk(k,j,i-1) )               &
-                       ) * adv_sca_1 
-
-             u_comp = u(k,j,i+1) - u_gtrans
-             fr_1   =  ( u_comp   * ( sk(k,j,i+1) + sk(k,j,i) )               &
-                   -ABS( u_comp ) * ( sk(k,j,i+1) - sk(k,j,i) )               &
-                       ) * adv_sca_1 
-
-             v_comp = v(k,j,i) - v_gtrans
-             fs_1   =  ( v_comp   * ( sk(k,j,i) + sk(k,j-1,i) )               &
-                   -ABS( v_comp ) * ( sk(k,j,i) - sk(k,j-1,i) )               &
-                       ) * adv_sca_1 
-
-             v_comp = v(k,j+1,i) - v_gtrans
-             fn_1   =  ( v_comp   * ( sk(k,j+1,i) + sk(k,j,i) )               &
-                   -ABS( v_comp ) * ( sk(k,j+1,i) - sk(k,j,i) )               &
-                       ) * adv_sca_1 
-
-             fd_1   =  ( w(k-1,j,i)   * ( sk(k,j,i) + sk(k-1,j,i) )           &
-                   -ABS( w(k-1,j,i) ) * ( sk(k,j,i) - sk(k-1,j,i) )           &
-                       ) * adv_sca_1 
-
-             ft_1   =  ( w(k,j,i)   * ( sk(k+1,j,i) + sk(k,j,i) )             &
-                   -ABS( w(k,j,i) ) * ( sk(k+1,j,i) - sk(k,j,i) )             &
-                       ) * adv_sca_1 
-!
-!--          Calculate ratio of upwind gradients. Note, Min/Max is just to 
-!--          avoid if statements. 
-             rl     = ( MAX( 0.0_wp, u(k,j,i) - u_gtrans ) *                  & 
-                           ABS( ( sk(k,j,i-1) - sk(k,j,i-2)            ) /    &
-                                ( sk(k,j,i)   - sk(k,j,i-1) + 1E-20_wp )      &
-                              ) +                                             & 
-                        MIN( 0.0_wp, u(k,j,i) - u_gtrans ) *                  &
-                           ABS( ( sk(k,j,i)   - sk(k,j,i+1)            ) /    &
-                                ( sk(k,j,i-1) - sk(k,j,i)   + 1E-20_wp )      &
-                              )                                               &
-                      ) / ABS( u(k,j,i) - u_gtrans + 1E-20_wp )
-
-             rr     = ( MAX( 0.0_wp, u(k,j,i+1) - u_gtrans ) *                & 
-                           ABS( ( sk(k,j,i)   - sk(k,j,i-1)            ) /    &
-                                ( sk(k,j,i+1) - sk(k,j,i)   + 1E-20_wp )      &
-                              ) +                                             & 
-                        MIN( 0.0_wp, u(k,j,i+1) - u_gtrans ) *                &
-                           ABS( ( sk(k,j,i+1) - sk(k,j,i+2)            ) /    &
-                                ( sk(k,j,i)   - sk(k,j,i+1) + 1E-20_wp )      &
-                              )                                               &
-                      ) / ABS( u(k,j,i+1) - u_gtrans + 1E-20_wp )
-
-             rs     = ( MAX( 0.0_wp, v(k,j,i) - v_gtrans ) *                  & 
-                           ABS( ( sk(k,j-1,i) - sk(k,j-2,i)            ) /    &
-                                ( sk(k,j,i)   - sk(k,j-1,i) + 1E-20_wp )      &
-                              ) +                                             & 
-                        MIN( 0.0_wp, v(k,j,i) - v_gtrans ) *                  &
-                           ABS( ( sk(k,j,i)   - sk(k,j+1,i)            ) /    &
-                                ( sk(k,j-1,i) - sk(k,j,i)   + 1E-20_wp )      &
-                              )                                               &
-                      ) / ABS( v(k,j,i) - v_gtrans + 1E-20_wp )
-
-             rn     = ( MAX( 0.0_wp, v(k,j+1,i) - v_gtrans ) *                & 
-                           ABS( ( sk(k,j,i)   - sk(k,j-1,i)            ) /    &
-                                ( sk(k,j+1,i) - sk(k,j,i)   + 1E-20_wp )      &
-                              ) +                                             & 
-                       MIN( 0.0_wp, v(k,j+1,i) - v_gtrans ) *                 &
-                           ABS( ( sk(k,j+1,i) - sk(k,j+2,i)            ) /    &
-                                ( sk(k,j,i)   - sk(k,j+1,i) + 1E-20_wp )      &
-                              )                                               &
-                      ) / ABS( v(k,j+1,i) - v_gtrans + 1E-20_wp )     
-!
-!--          Reuse k_mm and compute k_mmm for the vertical gradient ratios. 
-!--          Note, for vertical advection below the third grid point above 
-!--          surface ( or below the model top) rd and rt are set to 0, i.e. 
-!--          use of first order scheme is enforced.
-             k_mmm  = k - 3 * ibit8
-
-             rd     = ( MAX( 0.0_wp, w(k-1,j,i) ) *                           & 
-                           ABS( ( sk(k_mm,j,i) - sk(k_mmm,j,i)           ) /  &
-                                ( sk(k-1,j,i)  - sk(k_mm,j,i) + 1E-20_wp )    &
-                              ) +                                             & 
-                        MIN( 0.0_wp, w(k-1,j,i) ) *                           &
-                           ABS( ( sk(k-1,j,i) - sk(k,j,i)            ) /      &
-                                ( sk(k_mm,j,i) - sk(k-1,j,i)   + 1E-20_wp )   &
-                              )                                               &
-                      ) * ibit8 / ABS( w(k-1,j,i) + 1E-20_wp ) 
- 
-             rt     = ( MAX( 0.0_wp, w(k,j,i) ) *                             & 
-                           ABS( ( sk(k,j,i)   - sk(k-1,j,i)            ) /    &
-                                ( sk(k+1,j,i) - sk(k,j,i)   + 1E-20_wp )      &
-                              ) +                                             & 
-                        MIN( 0.0_wp, w(k,j,i) ) *                             &
-                           ABS( ( sk(k+1,j,i) - sk(k_pp,j,i)           ) /    &
-                                ( sk(k,j,i)   - sk(k+1,j,i) + 1E-20_wp )      &
-                              )                                               &
-                      ) * ibit8 / ABS( w(k,j,i) + 1E-20_wp ) 
-!
-!--           Calculate empirical limiter function (van Albada2 limiter).
-              phi_l = MIN( 1.0_wp, ( 2.0_wp * ABS( rl ) ) /                   &
-                                         ( rl**2 + 1.0_wp ) ) 
-              phi_r = MIN( 1.0_wp, ( 2.0_wp * ABS( rr ) ) /                   &
-                                         ( rr**2 + 1.0_wp ) ) 
-              phi_s = MIN( 1.0_wp, ( 2.0_wp * ABS( rs ) ) /                   &
-                                         ( rs**2 + 1.0_wp ) ) 
-              phi_n = MIN( 1.0_wp, ( 2.0_wp * ABS( rn ) ) /                   &
-                                         ( rn**2 + 1.0_wp ) ) 
-              phi_d = MIN( 1.0_wp, ( 2.0_wp * ABS( rd ) ) /                   &
-                                         ( rd**2 + 1.0_wp ) ) 
-              phi_t = MIN( 1.0_wp, ( 2.0_wp * ABS( rt ) ) /                   &
-                                         ( rt**2 + 1.0_wp ) ) 
-!
-!--           Calculate the resulting monotone flux. 
-              swap_flux_x_local(k,j,tn) = fl_1 - phi_l *                      &
-                                        ( fl_1 - swap_flux_x_local(k,j,tn)  )
-              flux_r(k)                 = fr_1 - phi_r *                      &
-                                        ( fr_1 - flux_r(k)                  )
-              swap_flux_y_local(k,tn)   = fs_1 - phi_s *                      &
-                                        ( fs_1 - swap_flux_y_local(k,tn)    )
-              flux_n(k)                 = fn_1 - phi_n *                      &
-                                        ( fn_1 - flux_n(k)                  )
-              flux_d                    = fd_1 - phi_d *                      &
-                                        ( fd_1 - flux_d                     )
-              flux_t(k)                 = ft_1 - phi_t *                      &
-                                        ( ft_1 - flux_t(k)                  )
-!
-!--          Moreover, modify dissipation flux according to the limiter. 
-             swap_diss_x_local(k,j,tn) = swap_diss_x_local(k,j,tn) * phi_l
-             diss_r(k)                 = diss_r(k)                 * phi_r
-             swap_diss_y_local(k,tn)   = swap_diss_y_local(k,tn)   * phi_s
-             diss_n(k)                 = diss_n(k)                 * phi_n
-             diss_d                    = diss_d                    * phi_d
-             diss_t(k)                 = diss_t(k)                 * phi_t
-
-          ENDIF
-!
-!--       Calculate the divergence of the velocity field. A respective
-!--       correction is needed to overcome numerical instabilities introduced
-!--       by a not sufficient reduction of divergences near topography.
-          div         =   ( u(k,j,i+1) - u(k,j,i)   ) * ddx                   &
-                        + ( v(k,j+1,i) - v(k,j,i)   ) * ddy                   &
-                        + ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)
-
-          tend(k,j,i) = tend(k,j,i) - (                                       &
-                        ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j,tn) - &
-                          swap_diss_x_local(k,j,tn)            ) * ddx        &
-                      + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k,tn)   - &
-                          swap_diss_y_local(k,tn)              ) * ddy        &
-                      + ( flux_t(k) + diss_t(k) - flux_d - diss_d             &
-                                                               ) * ddzw(k)    &
-                                      ) + sk(k,j,i) * div
-
-
-          swap_flux_y_local(k,tn)   = flux_n(k)
-          swap_diss_y_local(k,tn)   = diss_n(k)
-          swap_flux_x_local(k,j,tn) = flux_r(k)
-          swap_diss_x_local(k,j,tn) = diss_r(k)
-          flux_d                    = flux_t(k)
-          diss_d                    = diss_t(k)
-
-       ENDDO
-
-!
-!--    Evaluation of statistics.
-       SELECT CASE ( sk_char )
-
-          CASE ( 'pt' )
-
-             DO  k = nzb, nzt
-                sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn) +               &
-                                       ( flux_t(k) + diss_t(k) )              &
-                               * weight_substep(intermediate_timestep_count)
-             ENDDO
-            
-          CASE ( 'sa' )
-
-             DO  k = nzb, nzt
-                sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn) +               &
-                                       ( flux_t(k) + diss_t(k) )              &
-                               * weight_substep(intermediate_timestep_count)
-             ENDDO
-            
-          CASE ( 'q' )
-
-             DO  k = nzb, nzt
-                sums_wsqs_ws_l(k,tn)  = sums_wsqs_ws_l(k,tn) +                &
-                                      ( flux_t(k) + diss_t(k) )               &
-                               * weight_substep(intermediate_timestep_count)
-             ENDDO
-
-          CASE ( 'qr' )
-
-             DO  k = nzb, nzt
-                sums_wsqrs_ws_l(k,tn)  = sums_wsqrs_ws_l(k,tn) +              &
-                                      ( flux_t(k) + diss_t(k) )               &
-                               * weight_substep(intermediate_timestep_count)
-             ENDDO
-
-          CASE ( 'nr' )
-
-             DO  k = nzb, nzt
-                sums_wsnrs_ws_l(k,tn)  = sums_wsnrs_ws_l(k,tn) +              &
-                                      ( flux_t(k) + diss_t(k) )               &
-                               * weight_substep(intermediate_timestep_count)
-             ENDDO
-
-         END SELECT
-         
-    END SUBROUTINE advec_s_ws_ij
-
-
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Advection of u-component - Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_u_ws_ij( i, j, i_omp, tn )
-
-       USE arrays_3d,                                                         &
-           ONLY:  ddzw, diss_l_u, diss_s_u, flux_l_u, flux_s_u, tend, u, v, w
-
-       USE constants,                                                         &
-           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
-
-       USE control_parameters,                                                &
-           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
-
-       USE grid_variables,                                                    &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                           &
-           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0
-
-       USE kinds
-
-       USE statistics,                                                        &
-           ONLY:  hom, sums_us2_ws_l, sums_wsus_ws_l, weight_substep
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  ibit9  !<
-       INTEGER(iwp) ::  ibit10 !<
-       INTEGER(iwp) ::  ibit11 !<
-       INTEGER(iwp) ::  ibit12 !<
-       INTEGER(iwp) ::  ibit13 !<
-       INTEGER(iwp) ::  ibit14 !<
-       INTEGER(iwp) ::  ibit15 !<
-       INTEGER(iwp) ::  ibit16 !<
-       INTEGER(iwp) ::  ibit17 !<
-       INTEGER(iwp) ::  i_omp  !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  k      !<
-       INTEGER(iwp) ::  k_mm   !<
-       INTEGER(iwp) ::  k_pp   !<
-       INTEGER(iwp) ::  k_ppp  !<
-       INTEGER(iwp) ::  tn     !<
-       
-       REAL(wp)    ::  diss_d   !<
-       REAL(wp)    ::  div      !<
-       REAL(wp)    ::  flux_d   !<
-       REAL(wp)    ::  gu       !<
-       REAL(wp)    ::  gv       !<
-       REAL(wp)    ::  u_comp_l !<
-       REAL(wp)    ::  v_comp   !<
-       REAL(wp)    ::  w_comp   !<
-       
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_n !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_r !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  diss_t !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_n !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_r !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  flux_t !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  u_comp !<
-
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-!
-!--    Compute southside fluxes for the respective boundary of PE
-       IF ( j == nys  )  THEN
-       
-          DO  k = nzb+1, nzb_max
-
-             ibit14 = IBITS(wall_flags_0(k,j-1,i),14,1)
-             ibit13 = IBITS(wall_flags_0(k,j-1,i),13,1)
-             ibit12 = IBITS(wall_flags_0(k,j-1,i),12,1)
-
-             v_comp      = v(k,j,i) + v(k,j,i-1) - gv
-             flux_s_u(k,tn) = v_comp * (                                      &
-                            ( 37.0_wp * ibit14 * adv_mom_5                    &
-                         +     7.0_wp * ibit13 * adv_mom_3                    &
-                         +              ibit12 * adv_mom_1                    &
-                            ) *                                               &
-                                        ( u(k,j,i)   + u(k,j-1,i) )           &
-                     -      (  8.0_wp * ibit14 * adv_mom_5                    &
-                         +              ibit13 * adv_mom_3                    &
-                            ) *                                               &
-                                        ( u(k,j+1,i) + u(k,j-2,i) )           &
-                     +      (           ibit14 * adv_mom_5                    &
-                            ) *                                               &
-                                        ( u(k,j+2,i) + u(k,j-3,i) )           &
-                                       )
-
-             diss_s_u(k,tn) = - ABS ( v_comp ) * (                            &
-                            ( 10.0_wp * ibit14 * adv_mom_5                    &
-                         +     3.0_wp * ibit13 * adv_mom_3                    &
-                         +              ibit12 * adv_mom_1                    &
-                            ) *                                               &
-                                        ( u(k,j,i)   - u(k,j-1,i) )           &
-                     -      (  5.0_wp * ibit14 * adv_mom_5                    &
-                         +              ibit13 * adv_mom_3                    &
-                            ) *                                               &
-                                        ( u(k,j+1,i) - u(k,j-2,i) )           &
-                     +      (           ibit14 * adv_mom_5                    &
-                            ) *                                               &
-                                        ( u(k,j+2,i) - u(k,j-3,i) )           &
-                                                 )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             v_comp         = v(k,j,i) + v(k,j,i-1) - gv
-             flux_s_u(k,tn) = v_comp * (                                      &
-                           37.0_wp * ( u(k,j,i) + u(k,j-1,i)   )              &
-                         -  8.0_wp * ( u(k,j+1,i) + u(k,j-2,i) )              &
-                         +           ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5
-             diss_s_u(k,tn) = - ABS(v_comp) * (                               &
-                           10.0_wp * ( u(k,j,i) - u(k,j-1,i)   )              &
-                         -  5.0_wp * ( u(k,j+1,i) - u(k,j-2,i) )              &
-                         +           ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_5
-
-          ENDDO
-          
-       ENDIF
-!
-!--    Compute leftside fluxes for the respective boundary of PE
-       IF ( i == i_omp )  THEN
-       
-          DO  k = nzb+1, nzb_max
-
-             ibit11 = IBITS(wall_flags_0(k,j,i-1),11,1)
-             ibit10 = IBITS(wall_flags_0(k,j,i-1),10,1)
-             ibit9  = IBITS(wall_flags_0(k,j,i-1),9,1)
-
-             u_comp_l         = u(k,j,i) + u(k,j,i-1) - gu
-             flux_l_u(k,j,tn) = u_comp_l * (                                  &
-                              ( 37.0_wp * ibit11 * adv_mom_5                  &
-                           +     7.0_wp * ibit10 * adv_mom_3                  &
-                           +              ibit9  * adv_mom_1                  &
-                              ) *                                             &
-                                          ( u(k,j,i)   + u(k,j,i-1) )         &
-                       -      (  8.0_wp * ibit11 * adv_mom_5                  &
-                           +              ibit10 * adv_mom_3                  &
-                              ) *                                             &
-                                          ( u(k,j,i+1) + u(k,j,i-2) )         &
-                       +      (           ibit11 * adv_mom_5                  &
-                              ) *                                             &
-                                          ( u(k,j,i+2) + u(k,j,i-3) )         &
-                                           )
-
-              diss_l_u(k,j,tn) = - ABS( u_comp_l ) * (                        &
-                              ( 10.0_wp * ibit11 * adv_mom_5                  &
-                           +     3.0_wp * ibit10 * adv_mom_3                  &
-                           +              ibit9  * adv_mom_1                  &
-                              ) *                                             &
-                                        ( u(k,j,i)   - u(k,j,i-1) )           &
-                       -      (  5.0_wp * ibit11 * adv_mom_5                  &
-                           +              ibit10 * adv_mom_3                  &
-                              ) *                                             &
-                                        ( u(k,j,i+1) - u(k,j,i-2) )           &
-                       +      (           ibit11 * adv_mom_5                  &
-                              ) *                                             &
-                                        ( u(k,j,i+2) - u(k,j,i-3) )           &
-                                                     )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             u_comp_l         = u(k,j,i) + u(k,j,i-1) - gu
-             flux_l_u(k,j,tn) = u_comp_l * (                                   &
-                             37.0_wp * ( u(k,j,i) + u(k,j,i-1)   )             &
-                           -  8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) )             &
-                           +           ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_5
-             diss_l_u(k,j,tn) = - ABS(u_comp_l) * (                            &
-                             10.0_wp * ( u(k,j,i) - u(k,j,i-1)   )             &
-                           -  5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) )             &
-                           +           ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_5
-
-          ENDDO
-          
-       ENDIF
-
-       flux_t(0) = 0.0_wp
-       diss_t(0) = 0.0_wp
-       flux_d    = 0.0_wp
-       diss_d    = 0.0_wp
-!
-!--    Now compute the fluxes tendency terms for the horizontal and
-!--    vertical parts.
-       DO  k = nzb+1, nzb_max
-
-          ibit11 = IBITS(wall_flags_0(k,j,i),11,1)
-          ibit10 = IBITS(wall_flags_0(k,j,i),10,1)
-          ibit9  = IBITS(wall_flags_0(k,j,i),9,1)
-
-          u_comp(k) = u(k,j,i+1) + u(k,j,i)
-          flux_r(k) = ( u_comp(k) - gu ) * (                                  &
-                     ( 37.0_wp * ibit11 * adv_mom_5                           &
-                  +     7.0_wp * ibit10 * adv_mom_3                           &
-                  +              ibit9  * adv_mom_1                           &
-                     ) *                                                      &
-                                    ( u(k,j,i+1) + u(k,j,i)   )               &
-              -      (  8.0_wp * ibit11 * adv_mom_5                           &
-                  +              ibit10 * adv_mom_3                           & 
-                     ) *                                                      &
-                                    ( u(k,j,i+2) + u(k,j,i-1) )               &
-              +      (           ibit11 * adv_mom_5                           &
-                     ) *                                                      &
-                                    ( u(k,j,i+3) + u(k,j,i-2) )               &
-                                           )
-
-          diss_r(k) = - ABS( u_comp(k) - gu ) * (                             &
-                     ( 10.0_wp * ibit11 * adv_mom_5                           &
-                  +     3.0_wp * ibit10 * adv_mom_3                           &
-                  +              ibit9  * adv_mom_1                           &
-                     ) *                                                      &
-                                    ( u(k,j,i+1) - u(k,j,i)   )               &
-              -      (  5.0_wp * ibit11 * adv_mom_5                           &
-                  +              ibit10 * adv_mom_3                           &
-                     ) *                                                      &
-                                    ( u(k,j,i+2) - u(k,j,i-1) )               &
-              +      (           ibit11 * adv_mom_5                           &
-                     ) *                                                      &
-                                    ( u(k,j,i+3) - u(k,j,i-2) )               &
-                                                )
-
-          ibit14 = IBITS(wall_flags_0(k,j,i),14,1)
-          ibit13 = IBITS(wall_flags_0(k,j,i),13,1)
-          ibit12 = IBITS(wall_flags_0(k,j,i),12,1)
-
-          v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
-          flux_n(k) = v_comp * (                                              &
-                     ( 37.0_wp * ibit14 * adv_mom_5                           &
-                  +     7.0_wp * ibit13 * adv_mom_3                           &
-                  +              ibit12 * adv_mom_1                           &
-                     ) *                                                      &
-                                    ( u(k,j+1,i) + u(k,j,i)   )               &
-              -      (  8.0_wp * ibit14 * adv_mom_5                           &
-                  +              ibit13 * adv_mom_3                           &
-                     ) *                                                      &
-                                    ( u(k,j+2,i) + u(k,j-1,i) )               &
-              +      (           ibit14 * adv_mom_5                           &
-                     ) *                                                      &
-                                    ( u(k,j+3,i) + u(k,j-2,i) )               &
-                               )
-
-          diss_n(k) = - ABS ( v_comp ) * (                                    &
-                     ( 10.0_wp * ibit14 * adv_mom_5                           &
-                  +     3.0_wp * ibit13 * adv_mom_3                           &
-                  +              ibit12 * adv_mom_1                           &
-                     ) *                                                      &
-                                    ( u(k,j+1,i) - u(k,j,i)   )               &
-              -      (  5.0_wp * ibit14 * adv_mom_5                           &
-                  +              ibit13 * adv_mom_3                           &
-                     ) *                                                      &
-                                    ( u(k,j+2,i) - u(k,j-1,i) )               &
-              +      (           ibit14 * adv_mom_5                           &
-                     ) *                                                      &
-                                    ( u(k,j+3,i) - u(k,j-2,i) )               &
-                                         )
-!
-!--       k index has to be modified near bottom and top, else array
-!--       subscripts will be exceeded.
-          ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
-          ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
-          ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
-
-          k_ppp = k + 3 * ibit17
-          k_pp  = k + 2 * ( 1 - ibit15 )
-          k_mm  = k - 2 * ibit17
-
-          w_comp    = w(k,j,i) + w(k,j,i-1)
-          flux_t(k) = w_comp  * (                                             &
-                     ( 37.0_wp * ibit17 * adv_mom_5                           &
-                  +     7.0_wp * ibit16 * adv_mom_3                           &
-                  +              ibit15 * adv_mom_1                           &
-                     ) *                                                      &
-                                ( u(k+1,j,i)  + u(k,j,i)     )                &
-              -      (  8.0_wp * ibit17 * adv_mom_5                           &
-                  +              ibit16 * adv_mom_3                           &
-                     ) *                                                      &
-                                ( u(k_pp,j,i) + u(k-1,j,i)   )                &
-              +      (           ibit17 * adv_mom_5                           &
-                     ) *                                                      &
-                                ( u(k_ppp,j,i) + u(k_mm,j,i) )                &
-                                 )
-
-          diss_t(k) = - ABS( w_comp ) * (                                     &
-                     ( 10.0_wp * ibit17 * adv_mom_5                           &
-                  +     3.0_wp * ibit16 * adv_mom_3                           &
-                  +              ibit15 * adv_mom_1                           &
-                     ) *                                                      &
-                                ( u(k+1,j,i)   - u(k,j,i)    )                &
-              -      (  5.0_wp * ibit17 * adv_mom_5                           &
-                  +              ibit16 * adv_mom_3                           &
-                     ) *                                                      &
-                                ( u(k_pp,j,i)  - u(k-1,j,i)  )                &
-              +      (           ibit17 * adv_mom_5                           &
-                     ) *                                                      &
-                                ( u(k_ppp,j,i) - u(k_mm,j,i) )                &
-                                         )
-!
-!--       Calculate the divergence of the velocity field. A respective
-!--       correction is needed to overcome numerical instabilities introduced
-!--       by a not sufficient reduction of divergences near topography. 
-          div = ( ( u_comp(k)       * ( ibit9 + ibit10 + ibit11 )             &
-                - ( u(k,j,i)   + u(k,j,i-1)   )                               &
-                                    * ( IBITS(wall_flags_0(k,j,i-1),9,1)      &
-                                      + IBITS(wall_flags_0(k,j,i-1),10,1)     &
-                                      + IBITS(wall_flags_0(k,j,i-1),11,1)     &
-                                      )                                       &   
-                  ) * ddx                                                     &
-               +  ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 )            &
-                  - ( v(k,j,i)   + v(k,j,i-1 )  )                             &
-                                    * ( IBITS(wall_flags_0(k,j-1,i),12,1)     &
-                                      + IBITS(wall_flags_0(k,j-1,i),13,1)     &
-                                      + IBITS(wall_flags_0(k,j-1,i),14,1)     &
-                                      )                                       &
-                  ) * ddy                                                     &
-               +  ( w_comp          * ( ibit15 + ibit16 + ibit17 )            &
-                - ( w(k-1,j,i) + w(k-1,j,i-1) )                               &
-                                    * ( IBITS(wall_flags_0(k-1,j,i),15,1)     &
-                                      + IBITS(wall_flags_0(k-1,j,i),16,1)     &
-                                      + IBITS(wall_flags_0(k-1,j,i),17,1)     &
-                                      )                                       &  
-                  ) * ddzw(k)   &
-                ) * 0.5_wp
-
-
-          tend(k,j,i) = tend(k,j,i) - (                                       &
-                            ( flux_r(k) + diss_r(k)                           &
-                          -   flux_l_u(k,j,tn) - diss_l_u(k,j,tn) ) * ddx     &
-                          + ( flux_n(k) + diss_n(k)                           &
-                          -   flux_s_u(k,tn) - diss_s_u(k,tn)     ) * ddy     &
-                          + ( flux_t(k) + diss_t(k)                           &
-                          -   flux_d    - diss_d                  ) * ddzw(k) &
-                                       ) + div * u(k,j,i)
-
-           flux_l_u(k,j,tn) = flux_r(k)
-           diss_l_u(k,j,tn) = diss_r(k)
-           flux_s_u(k,tn)   = flux_n(k)
-           diss_s_u(k,tn)   = diss_n(k)
-           flux_d           = flux_t(k)
-           diss_d           = diss_t(k)
-!
-!--        Statistical Evaluation of u'u'. The factor has to be applied for
-!--        right evaluation when gallilei_trans = .T. .
-           sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                          &
-                              + ( flux_r(k) *                                 &
-                                ( u_comp(k) - 2.0_wp * hom(k,1,1,0) )         &
-                              / ( u_comp(k) - gu + 1.0E-20_wp   )             &
-                              +   diss_r(k) *                                 &
-                                  ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0) )    &
-                              / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) )      &
-                              *   weight_substep(intermediate_timestep_count)
-!
-!--        Statistical Evaluation of w'u'.
-           sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                        &
-                              + ( flux_t(k) + diss_t(k) )                     &
-                              *   weight_substep(intermediate_timestep_count)
-       ENDDO
-
-       DO  k = nzb_max+1, nzt
-
-          u_comp(k) = u(k,j,i+1) + u(k,j,i)
-          flux_r(k) = ( u_comp(k) - gu ) * (                                  &
-                         37.0_wp * ( u(k,j,i+1) + u(k,j,i)   )                &
-                       -  8.0_wp * ( u(k,j,i+2) + u(k,j,i-1) )                &
-                       +           ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_5
-             diss_r(k) = - ABS( u_comp(k) - gu ) * (                          &
-                         10.0_wp * ( u(k,j,i+1) - u(k,j,i)   )                &
-                       -  5.0_wp * ( u(k,j,i+2) - u(k,j,i-1) )                &
-                       +           ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_5
-
-             v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
-             flux_n(k) = v_comp * (                                           &
-                         37.0_wp * ( u(k,j+1,i) + u(k,j,i)   )                &
-                       -  8.0_wp * ( u(k,j+2,i) + u(k,j-1,i) )                &
-                       +           ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_5
-             diss_n(k) = - ABS( v_comp ) * (                                  &
-                         10.0_wp * ( u(k,j+1,i) - u(k,j,i)   )                &
-                       -  5.0_wp * ( u(k,j+2,i) - u(k,j-1,i) )                &
-                       +           ( u(k,j+3,i) - u(k,j-2,i) ) ) * adv_mom_5
-!
-!--       k index has to be modified near bottom and top, else array
-!--       subscripts will be exceeded.
-          ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
-          ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
-          ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
-
-          k_ppp = k + 3 * ibit17
-          k_pp  = k + 2 * ( 1 - ibit15 )
-          k_mm  = k - 2 * ibit17
-
-          w_comp    = w(k,j,i) + w(k,j,i-1)
-          flux_t(k) = w_comp  * (                                             &
-                     ( 37.0_wp * ibit17 * adv_mom_5                           &
-                  +     7.0_wp * ibit16 * adv_mom_3                           &
-                  +              ibit15 * adv_mom_1                           &
-                     ) *                                                      &
-                                ( u(k+1,j,i)  + u(k,j,i)     )                &
-              -      (  8.0_wp * ibit17 * adv_mom_5                           &
-                  +              ibit16 * adv_mom_3                           &
-                     ) *                                                      &
-                                ( u(k_pp,j,i) + u(k-1,j,i)   )                &
-              +      (           ibit17 * adv_mom_5                           &
-                     ) *                                                      &
-                                ( u(k_ppp,j,i) + u(k_mm,j,i) )                &
-                                 )
-
-          diss_t(k) = - ABS( w_comp ) * (                                     &
-                     ( 10.0_wp * ibit17 * adv_mom_5                           &
-                  +     3.0_wp * ibit16 * adv_mom_3                           &
-                  +              ibit15 * adv_mom_1                           &
-                     ) *                                                      &
-                                ( u(k+1,j,i)   - u(k,j,i)    )                &
-              -      (  5.0_wp * ibit17 * adv_mom_5                           &
-                  +              ibit16 * adv_mom_3                           &
-                     ) *                                                      &
-                                ( u(k_pp,j,i)  - u(k-1,j,i)  )                &
-              +      (           ibit17 * adv_mom_5                           &
-                     ) *                                                      &
-                                ( u(k_ppp,j,i) - u(k_mm,j,i) )                &
-                                         )
-!
-!--       Calculate the divergence of the velocity field. A respective
-!--       correction is needed to overcome numerical instabilities introduced
-!--       by a not sufficient reduction of divergences near topography.
-          div = ( ( u_comp(k)   - ( u(k,j,i)   + u(k,j,i-1)   ) ) * ddx       &
-               +  ( v_comp + gv - ( v(k,j,i)   + v(k,j,i-1 )  ) ) * ddy       &
-               +  ( w_comp      - ( w(k-1,j,i) + w(k-1,j,i-1) ) ) * ddzw(k)   &
-                ) * 0.5_wp
-
-          tend(k,j,i) = tend(k,j,i) - (                                       &
-                            ( flux_r(k) + diss_r(k)                           &
-                          -   flux_l_u(k,j,tn) - diss_l_u(k,j,tn) ) * ddx     &
-                          + ( flux_n(k) + diss_n(k)                           &
-                          -   flux_s_u(k,tn) - diss_s_u(k,tn)     ) * ddy     &
-                          + ( flux_t(k) + diss_t(k)                           &
-                          -   flux_d    - diss_d                  ) * ddzw(k) &
-                                       ) + div * u(k,j,i)
-
-           flux_l_u(k,j,tn) = flux_r(k)
-           diss_l_u(k,j,tn) = diss_r(k)
-           flux_s_u(k,tn)   = flux_n(k)
-           diss_s_u(k,tn)   = diss_n(k)
-           flux_d           = flux_t(k)
-           diss_d           = diss_t(k)
-!
-!--        Statistical Evaluation of u'u'. The factor has to be applied for
-!--        right evaluation when gallilei_trans = .T. .
-           sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                          &
-                              + ( flux_r(k) *                                 &
-                                ( u_comp(k) - 2.0_wp * hom(k,1,1,0)      )    &
-                              / ( u_comp(k) - gu + 1.0E-20_wp          )      &
-                              +   diss_r(k) *                                 &
-                                  ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0) )    &
-                              / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) )      &
-                              *   weight_substep(intermediate_timestep_count)
-!
-!--        Statistical Evaluation of w'u'.
-           sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                        &
-                              + ( flux_t(k) + diss_t(k) )                     &
-                              *   weight_substep(intermediate_timestep_count)
-       ENDDO
-
-       sums_us2_ws_l(nzb,tn) = sums_us2_ws_l(nzb+1,tn)
-
-
-
-    END SUBROUTINE advec_u_ws_ij
-
-
-
-!-----------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Advection of v-component - Call for grid point i,j
-!-----------------------------------------------------------------------------!
-   SUBROUTINE advec_v_ws_ij( i, j, i_omp, tn )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, diss_l_v, diss_s_v, flux_l_v, flux_s_v, tend, u, v, w
-
-       USE constants,                                                          &
-           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
-
-       USE control_parameters,                                                 &
-           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, wall_flags_0
-
-       USE kinds
-
-       USE statistics,                                                         &
-           ONLY:  hom, sums_vs2_ws_l, sums_wsvs_ws_l, weight_substep
-
-       IMPLICIT NONE
-
-       INTEGER(iwp)  ::  i      !<
-       INTEGER(iwp)  ::  ibit18 !<
-       INTEGER(iwp)  ::  ibit19 !<
-       INTEGER(iwp)  ::  ibit20 !<
-       INTEGER(iwp)  ::  ibit21 !<
-       INTEGER(iwp)  ::  ibit22 !<
-       INTEGER(iwp)  ::  ibit23 !<
-       INTEGER(iwp)  ::  ibit24 !<
-       INTEGER(iwp)  ::  ibit25 !<
-       INTEGER(iwp)  ::  ibit26 !<
-       INTEGER(iwp)  ::  i_omp  !<
-       INTEGER(iwp)  ::  j      !<
-       INTEGER(iwp)  ::  k      !<
-       INTEGER(iwp)  ::  k_mm   !<
-       INTEGER(iwp)  ::  k_pp   !<
-       INTEGER(iwp)  ::  k_ppp  !<
-       INTEGER(iwp)  ::  tn     !<
-       
-       REAL(wp)     ::  diss_d   !<
-       REAL(wp)     ::  div      !<
-       REAL(wp)     ::  flux_d   !<
-       REAL(wp)     ::  gu       !<
-       REAL(wp)     ::  gv       !<
-       REAL(wp)     ::  u_comp   !<
-       REAL(wp)     ::  v_comp_l !<
-       REAL(wp)     ::  w_comp   !<
-       
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_n !<
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_r !<
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_t !<
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_n !<
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_r !<
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_t !<
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  v_comp !<
-
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-
-!       
-!--    Compute leftside fluxes for the respective boundary.
-       IF ( i == i_omp )  THEN
-
-          DO  k = nzb+1, nzb_max
-
-             ibit20 = IBITS(wall_flags_0(k,j,i-1),20,1)
-             ibit19 = IBITS(wall_flags_0(k,j,i-1),19,1)
-             ibit18 = IBITS(wall_flags_0(k,j,i-1),18,1)
-
-             u_comp           = u(k,j-1,i) + u(k,j,i) - gu
-             flux_l_v(k,j,tn) = u_comp * (                                    &
-                              ( 37.0_wp * ibit20 * adv_mom_5                  &
-                           +     7.0_wp * ibit19 * adv_mom_3                  &
-                           +              ibit18 * adv_mom_1                  &
-                              ) *                                             &
-                                        ( v(k,j,i)   + v(k,j,i-1) )           &
-                       -      (  8.0_wp * ibit20 * adv_mom_5                  &
-                           +              ibit19 * adv_mom_3                  &
-                              ) *                                             &
-                                        ( v(k,j,i+1) + v(k,j,i-2) )           &
-                       +      (           ibit20 * adv_mom_5                  &
-                              ) *                                             &
-                                        ( v(k,j,i+2) + v(k,j,i-3) )           &
-                                         )
-
-              diss_l_v(k,j,tn) = - ABS( u_comp ) * (                          &
-                              ( 10.0_wp * ibit20 * adv_mom_5                  &
-                           +     3.0_wp * ibit19 * adv_mom_3                  &
-                           +              ibit18 * adv_mom_1                  &
-                              ) *                                             &
-                                        ( v(k,j,i)   - v(k,j,i-1) )           &
-                       -      (  5.0_wp * ibit20 * adv_mom_5                  &
-                           +              ibit19 * adv_mom_3                  &
-                              ) *                                             &
-                                        ( v(k,j,i+1) - v(k,j,i-2) )           &
-                       +      (           ibit20 * adv_mom_5                  &
-                              ) *                                             &
-                                        ( v(k,j,i+2) - v(k,j,i-3) )           &
-                                                   )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             u_comp           = u(k,j-1,i) + u(k,j,i) - gu
-             flux_l_v(k,j,tn) = u_comp * (                                    &
-                             37.0_wp * ( v(k,j,i) + v(k,j,i-1)   )            &
-                           -  8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) )            &
-                           +           ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5
-             diss_l_v(k,j,tn) = - ABS( u_comp ) * (                           &
-                             10.0_wp * ( v(k,j,i) - v(k,j,i-1)   )            &
-                           -  5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) )            &
-                           +           ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5
-
-          ENDDO
-          
-       ENDIF
-!
-!--    Compute southside fluxes for the respective boundary.
-       IF ( j == nysv )  THEN
-       
-          DO  k = nzb+1, nzb_max
-
-             ibit23 = IBITS(wall_flags_0(k,j-1,i),23,1)
-             ibit22 = IBITS(wall_flags_0(k,j-1,i),22,1)
-             ibit21 = IBITS(wall_flags_0(k,j-1,i),21,1)
-
-             v_comp_l       = v(k,j,i) + v(k,j-1,i) - gv
-             flux_s_v(k,tn) = v_comp_l * (                                    &
-                            ( 37.0_wp * ibit23 * adv_mom_5                    &
-                         +     7.0_wp * ibit22 * adv_mom_3                    &
-                         +              ibit21 * adv_mom_1                    &
-                            ) *                                               &
-                                        ( v(k,j,i)   + v(k,j-1,i) )           &
-                     -      (  8.0_wp * ibit23 * adv_mom_5                    &
-                         +              ibit22 * adv_mom_3                    &
-                            ) *                                               &
-                                        ( v(k,j+1,i) + v(k,j-2,i) )           &
-                     +      (           ibit23 * adv_mom_5                    &
-                            ) *                                               &
-                                        ( v(k,j+2,i) + v(k,j-3,i) )           &
-                                         )
-
-             diss_s_v(k,tn) = - ABS( v_comp_l ) * (                           &
-                            ( 10.0_wp * ibit23 * adv_mom_5                    &
-                         +     3.0_wp * ibit22 * adv_mom_3                    &
-                         +              ibit21 * adv_mom_1                    &
-                            ) *                                               &
-                                        ( v(k,j,i)   - v(k,j-1,i) )           &
-                     -      (  5.0_wp * ibit23 * adv_mom_5                    &
-                         +              ibit22 * adv_mom_3                    &
-                            ) *                                               &
-                                        ( v(k,j+1,i) - v(k,j-2,i) )           &
-                     +      (           ibit23 * adv_mom_5                    &
-                            ) *                                               &
-                                        ( v(k,j+2,i) - v(k,j-3,i) )           &
-                                                  )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             v_comp_l       = v(k,j,i) + v(k,j-1,i) - gv
-             flux_s_v(k,tn) = v_comp_l * (                                    &
-                           37.0_wp * ( v(k,j,i) + v(k,j-1,i)   )              &
-                         -  8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) )              &
-                         +           ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5
-             diss_s_v(k,tn) = - ABS( v_comp_l ) * (                           &
-                           10.0_wp * ( v(k,j,i) - v(k,j-1,i)   )              &
-                         -  5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) )              &
-                         +           ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5
-
-          ENDDO
-          
-       ENDIF
-
-       flux_t(0) = 0.0_wp
-       diss_t(0) = 0.0_wp
-       flux_d    = 0.0_wp
-       diss_d    = 0.0_wp
-!
-!--    Now compute the fluxes and tendency terms for the horizontal and
-!--    verical parts.
-       DO  k = nzb+1, nzb_max
-
-          ibit20 = IBITS(wall_flags_0(k,j,i),20,1)
-          ibit19 = IBITS(wall_flags_0(k,j,i),19,1)
-          ibit18 = IBITS(wall_flags_0(k,j,i),18,1)
- 
-          u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
-          flux_r(k) = u_comp * (                                              &
-                     ( 37.0_wp * ibit20 * adv_mom_5                           &
-                  +     7.0_wp * ibit19 * adv_mom_3                           &
-                  +              ibit18 * adv_mom_1                           &
-                     ) *                                                      &
-                                    ( v(k,j,i+1) + v(k,j,i)   )               &
-              -      (  8.0_wp * ibit20 * adv_mom_5                           &
-                  +              ibit19 * adv_mom_3                           &
-                     ) *                                                      &
-                                    ( v(k,j,i+2) + v(k,j,i-1) )               &
-              +      (           ibit20 * adv_mom_5                           &
-                     ) *                                                      &
-                                    ( v(k,j,i+3) + v(k,j,i-2) )               &
-                               )
-
-          diss_r(k) = - ABS( u_comp ) * (                                     &
-                     ( 10.0_wp * ibit20 * adv_mom_5                           &
-                  +     3.0_wp * ibit19 * adv_mom_3                           &
-                  +              ibit18 * adv_mom_1                           &
-                     ) *                                                      &
-                                    ( v(k,j,i+1) - v(k,j,i)  )                &
-              -      (  5.0_wp * ibit20 * adv_mom_5                           &
-                  +              ibit19 * adv_mom_3                           &
-                     ) *                                                      &
-                                    ( v(k,j,i+2) - v(k,j,i-1) )               &
-              +      (           ibit20 * adv_mom_5                           &
-                     ) *                                                      &
-                                    ( v(k,j,i+3) - v(k,j,i-2) )               &
-                                        )
-
-          ibit23 = IBITS(wall_flags_0(k,j,i),23,1)
-          ibit22 = IBITS(wall_flags_0(k,j,i),22,1)
-          ibit21 = IBITS(wall_flags_0(k,j,i),21,1)
-
-
-          v_comp(k) = v(k,j+1,i) + v(k,j,i)
-          flux_n(k) = ( v_comp(k) - gv ) * (                                  &
-                     ( 37.0_wp * ibit23 * adv_mom_5                           &
-                  +     7.0_wp * ibit22 * adv_mom_3                           &
-                  +              ibit21 * adv_mom_1                           &
-                     ) *                                                      &
-                                    ( v(k,j+1,i) + v(k,j,i)   )               &
-              -      (  8.0_wp * ibit23 * adv_mom_5                           &
-                  +              ibit22 * adv_mom_3                           &
-                     ) *                                                      &
-                                    ( v(k,j+2,i) + v(k,j-1,i) )               &
-              +      (           ibit23 * adv_mom_5                           &
-                     ) *                                                      &
-                                    ( v(k,j+3,i) + v(k,j-2,i) )               &
-                                           )
-
-          diss_n(k) = - ABS( v_comp(k) - gv ) * (                             &
-                     ( 10.0_wp * ibit23 * adv_mom_5                           &
-                  +     3.0_wp * ibit22 * adv_mom_3                           &
-                  +              ibit21 * adv_mom_1                           &
-                     ) *                                                      &
-                                    ( v(k,j+1,i) - v(k,j,i)   )               &
-              -      (  5.0_wp * ibit23 * adv_mom_5                           &
-                  +              ibit22 * adv_mom_3                           &
-                     ) *                                                      &
-                                    ( v(k,j+2,i) - v(k,j-1,i) )               &
-              +      (           ibit23 * adv_mom_5                           &
-                     ) *                                                      &
-                                    ( v(k,j+3,i) - v(k,j-2,i) )               &
-                                                )
-!
-!--       k index has to be modified near bottom and top, else array
-!--       subscripts will be exceeded.
-          ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
-          ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
-          ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
-
-          k_ppp = k + 3 * ibit26
-          k_pp  = k + 2 * ( 1 - ibit24  )
-          k_mm  = k - 2 * ibit26
-
-          w_comp    = w(k,j-1,i) + w(k,j,i)
-          flux_t(k) = w_comp  * (                                             &
-                     ( 37.0_wp * ibit26 * adv_mom_5                           &
-                  +     7.0_wp * ibit25 * adv_mom_3                           &
-                  +              ibit24 * adv_mom_1                           &
-                     ) *                                                      &
-                                ( v(k+1,j,i)   + v(k,j,i)    )                &
-              -      (  8.0_wp * ibit26 * adv_mom_5                           &
-                  +              ibit25 * adv_mom_3                           &
-                     ) *                                                      &
-                                ( v(k_pp,j,i)  + v(k-1,j,i)  )                &
-              +      (           ibit26 * adv_mom_5                           &
-                     ) *                                                      &
-                                ( v(k_ppp,j,i) + v(k_mm,j,i) )                &
-                                 )
-
-          diss_t(k) = - ABS( w_comp ) * (                                     &
-                     ( 10.0_wp * ibit26 * adv_mom_5                           &
-                  +     3.0_wp * ibit25 * adv_mom_3                           &
-                  +              ibit24 * adv_mom_1                           &
-                     ) *                                                      &
-                                ( v(k+1,j,i)   - v(k,j,i)    )                &
-              -      (  5.0_wp * ibit26 * adv_mom_5                           &
-                  +              ibit25 * adv_mom_3                           &
-                     ) *                                                      &
-                                ( v(k_pp,j,i)  - v(k-1,j,i)  )                &
-              +      (           ibit26 * adv_mom_5                           &
-                     ) *                                                      &
-                                ( v(k_ppp,j,i) - v(k_mm,j,i) )                &
-                                         )
-!
-!--       Calculate the divergence of the velocity field. A respective
-!--       correction is needed to overcome numerical instabilities introduced
-!--       by a not sufficient reduction of divergences near topography. 
-          div = ( ( ( u_comp     + gu )                                       &
-                                       * ( ibit18 + ibit19 + ibit20 )         &
-                  - ( u(k,j-1,i) + u(k,j,i) )                                 &
-                                       * ( IBITS(wall_flags_0(k,j,i-1),18,1)  &
-                                         + IBITS(wall_flags_0(k,j,i-1),19,1)  &
-                                         + IBITS(wall_flags_0(k,j,i-1),20,1)  &
-                                         )                                    &   
-                  ) * ddx                                                     &
-               +  ( v_comp(k)                                                 &
-                                       * ( ibit21 + ibit22 + ibit23 )         &
-                - ( v(k,j,i)     + v(k,j-1,i) )                               &
-                                       * ( IBITS(wall_flags_0(k,j-1,i),21,1)  &
-                                         + IBITS(wall_flags_0(k,j-1,i),22,1)  &
-                                         + IBITS(wall_flags_0(k,j-1,i),23,1)  &
-                                         )                                    &   
-                  ) * ddy                                                     &
-               +  ( w_comp                                                    &
-                                       * ( ibit24 + ibit25 + ibit26 )         &
-                - ( w(k-1,j-1,i) + w(k-1,j,i) )                               &
-                                       * ( IBITS(wall_flags_0(k-1,j,i),24,1)  &
-                                         + IBITS(wall_flags_0(k-1,j,i),25,1)  &
-                                         + IBITS(wall_flags_0(k-1,j,i),26,1)  &
-                                         )                                    &
-                   ) * ddzw(k)   &
-                ) * 0.5_wp
-
-
-          tend(k,j,i) = tend(k,j,i) - (                                       &
-                         ( flux_r(k) + diss_r(k)                              &
-                       -   flux_l_v(k,j,tn) - diss_l_v(k,j,tn)   ) * ddx      &
-                       + ( flux_n(k) + diss_n(k)                              &
-                       -   flux_s_v(k,tn) - diss_s_v(k,tn)       ) * ddy      &
-                       + ( flux_t(k) + diss_t(k)                              &
-                       -   flux_d    - diss_d                    ) * ddzw(k)  &
-                                      ) + v(k,j,i) * div
-
-           flux_l_v(k,j,tn) = flux_r(k)
-           diss_l_v(k,j,tn) = diss_r(k)
-           flux_s_v(k,tn)   = flux_n(k)
-           diss_s_v(k,tn)   = diss_n(k)
-           flux_d           = flux_t(k)
-           diss_d           = diss_t(k)
-
-!
-!--        Statistical Evaluation of v'v'. The factor has to be applied for
-!--        right evaluation when gallilei_trans = .T. .
-           sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                          &
-             + ( flux_n(k)                                                    &
-             * ( v_comp(k) - 2.0_wp * hom(k,1,2,0)      )                     &
-             / ( v_comp(k) - gv + 1.0E-20_wp       )                          &
-             +   diss_n(k)                                                    &
-             *   ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0) )                     &
-             / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) )                        &
-             *   weight_substep(intermediate_timestep_count)
-!
-!--        Statistical Evaluation of w'v'.
-           sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                        &
-                              + ( flux_t(k) + diss_t(k) )                     &
-                              *   weight_substep(intermediate_timestep_count)
-
-       ENDDO
-
-       DO  k = nzb_max+1, nzt
-
-          u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
-          flux_r(k) = u_comp * (                                              &
-                      37.0_wp * ( v(k,j,i+1) + v(k,j,i)   )                   &
-                    -  8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) )                   &
-                    +           ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_5
-
-          diss_r(k) = - ABS( u_comp ) * (                                     &
-                      10.0_wp * ( v(k,j,i+1) - v(k,j,i) )                     &
-                    -  5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) )                   &
-                    +           ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_5
-
-
-          v_comp(k) = v(k,j+1,i) + v(k,j,i)
-          flux_n(k) = ( v_comp(k) - gv ) * (                                  &
-                      37.0_wp * ( v(k,j+1,i) + v(k,j,i)   )                   &
-                    -  8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) )                   &
-                      +         ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_5
-
-          diss_n(k) = - ABS( v_comp(k) - gv ) * (                             &
-                      10.0_wp * ( v(k,j+1,i) - v(k,j,i)   )                   &
-                    -  5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) )                   &
-                    +           ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_5
-!
-!--       k index has to be modified near bottom and top, else array
-!--       subscripts will be exceeded.
-          ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
-          ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
-          ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
-
-          k_ppp = k + 3 * ibit26
-          k_pp  = k + 2 * ( 1 - ibit24  )
-          k_mm  = k - 2 * ibit26
-
-          w_comp    = w(k,j-1,i) + w(k,j,i)
-          flux_t(k) = w_comp  * (                                             &
-                     ( 37.0_wp * ibit26 * adv_mom_5                           &
-                  +     7.0_wp * ibit25 * adv_mom_3                           &
-                  +              ibit24 * adv_mom_1                           &
-                     ) *                                                      &
-                                ( v(k+1,j,i)   + v(k,j,i)    )                &
-              -      (  8.0_wp * ibit26 * adv_mom_5                           &
-                  +              ibit25 * adv_mom_3                           &
-                     ) *                                                      &
-                                ( v(k_pp,j,i)  + v(k-1,j,i)  )                &
-              +      (           ibit26 * adv_mom_5                           &
-                     ) *                                                      &
-                                ( v(k_ppp,j,i) + v(k_mm,j,i) )                &
-                                 )
-
-          diss_t(k) = - ABS( w_comp ) * (                                     &
-                     ( 10.0_wp * ibit26 * adv_mom_5                           &
-                  +     3.0_wp * ibit25 * adv_mom_3                           &
-                  +              ibit24 * adv_mom_1                           &
-                     ) *                                                      &
-                                ( v(k+1,j,i)   - v(k,j,i)    )                &
-              -      (  5.0_wp * ibit26 * adv_mom_5                           &
-                  +              ibit25 * adv_mom_3                           &
-                     ) *                                                      &
-                                ( v(k_pp,j,i)  - v(k-1,j,i)  )                &
-              +      (           ibit26 * adv_mom_5                           &
-                     ) *                                                      &
-                                ( v(k_ppp,j,i) - v(k_mm,j,i) )                &
-                                         )
-!
-!--       Calculate the divergence of the velocity field. A respective
-!--       correction is needed to overcome numerical instabilities introduced
-!--       by a not sufficient reduction of divergences near topography.
-          div = ( ( u_comp + gu - ( u(k,j-1,i)   + u(k,j,i)   ) ) * ddx       &
-               +  ( v_comp(k)   - ( v(k,j,i)     + v(k,j-1,i) ) ) * ddy       &
-               +  ( w_comp      - ( w(k-1,j-1,i) + w(k-1,j,i) ) ) * ddzw(k)   &
-                ) * 0.5_wp
-
-          tend(k,j,i) = tend(k,j,i) - (                                       &
-                         ( flux_r(k) + diss_r(k)                              &
-                       -   flux_l_v(k,j,tn) - diss_l_v(k,j,tn)   ) * ddx      &
-                       + ( flux_n(k) + diss_n(k)                              &
-                       -   flux_s_v(k,tn) - diss_s_v(k,tn)       ) * ddy      &
-                       + ( flux_t(k) + diss_t(k)                              &
-                       -   flux_d    - diss_d                    ) * ddzw(k)  &
-                                      ) + v(k,j,i) * div
-
-           flux_l_v(k,j,tn) = flux_r(k)
-           diss_l_v(k,j,tn) = diss_r(k)
-           flux_s_v(k,tn)   = flux_n(k)
-           diss_s_v(k,tn)   = diss_n(k)
-           flux_d           = flux_t(k)
-           diss_d           = diss_t(k)
-
-!
-!--        Statistical Evaluation of v'v'. The factor has to be applied for
-!--        right evaluation when gallilei_trans = .T. .
-           sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                          &
-             + ( flux_n(k)                                                    &
-             * ( v_comp(k) - 2.0_wp * hom(k,1,2,0)      )                     &
-             / ( v_comp(k) - gv + 1.0E-20_wp       )                          &
-             +   diss_n(k)                                                    &
-             *   ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0) )                     &
-             / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) )                        &
-             *   weight_substep(intermediate_timestep_count)
-!
-!--        Statistical Evaluation of w'v'.
-           sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                        &
-                              + ( flux_t(k) + diss_t(k) )                     &
-                              *   weight_substep(intermediate_timestep_count)
-
-       ENDDO
-       sums_vs2_ws_l(nzb,tn) = sums_vs2_ws_l(nzb+1,tn)
-
-
-    END SUBROUTINE advec_v_ws_ij
-
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Advection of w-component - Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_w_ws_ij( i, j, i_omp, tn )
-
-       USE arrays_3d,                                                         &
-           ONLY:  ddzu, diss_l_w, diss_s_w, flux_l_w, flux_s_w, tend, u, v, w
-
-       USE constants,                                                         &
-           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
-
-       USE control_parameters,                                                &
-           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
-
-       USE grid_variables,                                                    &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                           &
-           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0,        &
-                  wall_flags_00
-
-       USE kinds
-       
-       USE statistics,                                                        &
-           ONLY:  hom, sums_ws2_ws_l, weight_substep
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  ibit27 !<
-       INTEGER(iwp) ::  ibit28 !<
-       INTEGER(iwp) ::  ibit29 !<
-       INTEGER(iwp) ::  ibit30 !<
-       INTEGER(iwp) ::  ibit31 !<
-       INTEGER(iwp) ::  ibit32 !<
-       INTEGER(iwp) ::  ibit33 !<
-       INTEGER(iwp) ::  ibit34 !<
-       INTEGER(iwp) ::  ibit35 !<
-       INTEGER(iwp) ::  i_omp  !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  k      !<
-       INTEGER(iwp) ::  k_mm   !<
-       INTEGER(iwp) ::  k_pp   !<
-       INTEGER(iwp) ::  k_ppp  !<
-       INTEGER(iwp) ::  tn     !<
-       
-       REAL(wp)    ::  diss_d  !<
-       REAL(wp)    ::  div     !<
-       REAL(wp)    ::  flux_d  !<
-       REAL(wp)    ::  gu      !<
-       REAL(wp)    ::  gv      !<
-       REAL(wp)    ::  u_comp  !<
-       REAL(wp)    ::  v_comp  !<
-       REAL(wp)    ::  w_comp  !<
-       
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_n !<
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_r !<
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  diss_t !<
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_n !<
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_r !<
-       REAL(wp), DIMENSION(nzb:nzt+1)  ::  flux_t !<
-
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-
-!
-!--    Compute southside fluxes for the respective boundary.
-       IF ( j == nys )  THEN
-
-          DO  k = nzb+1, nzb_max
-             ibit32 = IBITS(wall_flags_00(k,j-1,i),0,1)
-             ibit31 = IBITS(wall_flags_0(k,j-1,i),31,1)
-             ibit30 = IBITS(wall_flags_0(k,j-1,i),30,1)
-
-             v_comp         = v(k+1,j,i) + v(k,j,i) - gv
-             flux_s_w(k,tn) = v_comp * (                                      &
-                            ( 37.0_wp * ibit32 * adv_mom_5                    &
-                         +     7.0_wp * ibit31 * adv_mom_3                    &
-                         +              ibit30 * adv_mom_1                    &
-                            ) *                                               &
-                                        ( w(k,j,i)   + w(k,j-1,i) )           &
-                     -      (  8.0_wp * ibit32 * adv_mom_5                    &
-                         +              ibit31 * adv_mom_3                    &
-                            ) *                                               &
-                                        ( w(k,j+1,i) + w(k,j-2,i) )           &
-                     +      (           ibit32 * adv_mom_5                    &
-                            ) *                                               &
-                                        ( w(k,j+2,i) + w(k,j-3,i) )           &
-                                       )
-
-             diss_s_w(k,tn) = - ABS( v_comp ) * (                             &
-                            ( 10.0_wp * ibit32 * adv_mom_5                    &
-                         +     3.0_wp * ibit31 * adv_mom_3                    &
-                         +              ibit30 * adv_mom_1                    &
-                            ) *                                               &
-                                        ( w(k,j,i)   - w(k,j-1,i) )           &
-                     -      (  5.0_wp * ibit32 * adv_mom_5                    &
-                         +              ibit31 * adv_mom_3                    &
-                            ) *                                               &
-                                        ( w(k,j+1,i) - w(k,j-2,i) )           &
-                     +      (           ibit32 * adv_mom_5                    &
-                            ) *                                               &
-                                        ( w(k,j+2,i) - w(k,j-3,i) )           &
-                                                )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             v_comp         = v(k+1,j,i) + v(k,j,i) - gv
-             flux_s_w(k,tn) = v_comp * (                                      &
-                           37.0_wp * ( w(k,j,i) + w(k,j-1,i)   )              &
-                         -  8.0_wp * ( w(k,j+1,i) +w(k,j-2,i)  )              &
-                         +           ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5
-             diss_s_w(k,tn) = - ABS( v_comp ) * (                             &
-                           10.0_wp * ( w(k,j,i) - w(k,j-1,i)   )              &
-                         -  5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) )              &
-                         +           ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5
-
-          ENDDO
-
-       ENDIF
-!
-!--    Compute leftside fluxes for the respective boundary.
-       IF ( i == i_omp ) THEN
-
-          DO  k = nzb+1, nzb_max
-
-             ibit29 = IBITS(wall_flags_0(k,j,i-1),29,1)
-             ibit28 = IBITS(wall_flags_0(k,j,i-1),28,1)
-             ibit27 = IBITS(wall_flags_0(k,j,i-1),27,1)
-
-             u_comp           = u(k+1,j,i) + u(k,j,i) - gu
-             flux_l_w(k,j,tn) = u_comp * (                                    &
-                             ( 37.0_wp * ibit29 * adv_mom_5                   &
-                          +     7.0_wp * ibit28 * adv_mom_3                   &
-                          +              ibit27 * adv_mom_1                   &
-                             ) *                                              &
-                                        ( w(k,j,i)   + w(k,j,i-1) )           &
-                      -      (  8.0_wp * ibit29 * adv_mom_5                   &
-                          +              ibit28 * adv_mom_3                   &
-                             ) *                                              &
-                                        ( w(k,j,i+1) + w(k,j,i-2) )           &
-                      +      (           ibit29 * adv_mom_5                   &
-                             ) *                                              &
-                                        ( w(k,j,i+2) + w(k,j,i-3) )           &
-                                         )
-
-               diss_l_w(k,j,tn) = - ABS( u_comp ) * (                         &
-                             ( 10.0_wp * ibit29 * adv_mom_5                   &
-                          +     3.0_wp * ibit28 * adv_mom_3                   &
-                          +              ibit27 * adv_mom_1                   &
-                             ) *                                              &
-                                        ( w(k,j,i)   - w(k,j,i-1) )           &
-                      -      (  5.0_wp * ibit29 * adv_mom_5                   &
-                          +              ibit28 * adv_mom_3                   &
-                             ) *                                              &
-                                        ( w(k,j,i+1) - w(k,j,i-2) )           &
-                      +      (           ibit29 * adv_mom_5                   &
-                             ) *                                              &
-                                        ( w(k,j,i+2) - w(k,j,i-3) )           &
-                                                    )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             u_comp           = u(k+1,j,i) + u(k,j,i) - gu
-             flux_l_w(k,j,tn) = u_comp * (                                    &
-                            37.0_wp * ( w(k,j,i) + w(k,j,i-1)   )             &
-                          -  8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) )             &
-                          +           ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5
-             diss_l_w(k,j,tn) = - ABS( u_comp ) * (                           &
-                            10.0_wp * ( w(k,j,i) - w(k,j,i-1)   )             &
-                          -  5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) )             &
-                          +           ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5 
-
-          ENDDO
-
-       ENDIF
-!
-!--    The lower flux has to be calculated explicetely for the tendency at
-!--    the first w-level. For topography wall this is done implicitely by
-!--    wall_flags_0.
-       k         = nzb + 1
-       w_comp    = w(k,j,i) + w(k-1,j,i)
-       flux_t(0) = w_comp       * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1
-       diss_t(0) = -ABS(w_comp) * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1
-       flux_d    = flux_t(0)
-       diss_d    = diss_t(0)
-!
-!--    Now compute the fluxes and tendency terms for the horizontal
-!--    and vertical parts.
-       DO  k = nzb+1, nzb_max
-
-          ibit29 = IBITS(wall_flags_0(k,j,i),29,1)
-          ibit28 = IBITS(wall_flags_0(k,j,i),28,1)
-          ibit27 = IBITS(wall_flags_0(k,j,i),27,1)
-
-          u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
-          flux_r(k) = u_comp * (                                              &
-                     ( 37.0_wp * ibit29 * adv_mom_5                           &
-                  +     7.0_wp * ibit28 * adv_mom_3                           &
-                  +              ibit27 * adv_mom_1                           &
-                     ) *                                                      &
-                                    ( w(k,j,i+1) + w(k,j,i)   )               &
-              -      (  8.0_wp * ibit29 * adv_mom_5                           &
-                  +              ibit28 * adv_mom_3                           &
-                     ) *                                                      &
-                                    ( w(k,j,i+2) + w(k,j,i-1) )               &
-              +      (           ibit29 * adv_mom_5                           &
-                     ) *                                                      &
-                                    ( w(k,j,i+3) + w(k,j,i-2) )               &
-                               )
-
-          diss_r(k) = - ABS( u_comp ) * (                                     &
-                     ( 10.0_wp * ibit29 * adv_mom_5                           &
-                  +     3.0_wp * ibit28 * adv_mom_3                           &
-                  +              ibit27 * adv_mom_1                           &
-                     ) *                                                      &
-                                    ( w(k,j,i+1) - w(k,j,i)   )               &
-              -      (  5.0_wp * ibit29 * adv_mom_5                           &
-                  +              ibit28 * adv_mom_3                           &
-                     ) *                                                      &
-                                    ( w(k,j,i+2) - w(k,j,i-1) )               &
-              +      (           ibit29 * adv_mom_5                           &
-                     ) *                                                      &
-                                    ( w(k,j,i+3) - w(k,j,i-2) )               &
-                                        )
-
-          ibit32 = IBITS(wall_flags_00(k,j,i),0,1)
-          ibit31 = IBITS(wall_flags_0(k,j,i),31,1)
-          ibit30 = IBITS(wall_flags_0(k,j,i),30,1)
-
-          v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
-          flux_n(k) = v_comp * (                                              &
-                     ( 37.0_wp * ibit32 * adv_mom_5                           &
-                  +     7.0_wp * ibit31 * adv_mom_3                           &
-                  +              ibit30 * adv_mom_1                           &
-                     ) *                                                      &
-                                    ( w(k,j+1,i) + w(k,j,i)   )               &
-              -      (  8.0_wp * ibit32 * adv_mom_5                           &
-                  +              ibit31 * adv_mom_3                           &
-                     ) *                                                      &
-                                    ( w(k,j+2,i) + w(k,j-1,i) )               &
-              +      (           ibit32 * adv_mom_5                           &
-                     ) *                                                      &
-                                    ( w(k,j+3,i) + w(k,j-2,i) )               &
-                               )
-
-          diss_n(k) = - ABS( v_comp ) * (                                     &
-                     ( 10.0_wp * ibit32 * adv_mom_5                           &
-                  +     3.0_wp * ibit31 * adv_mom_3                           &
-                  +              ibit30 * adv_mom_1                           &
-                     ) *                                                      &
-                                    ( w(k,j+1,i) - w(k,j,i)  )                &
-              -      (  5.0_wp * ibit32 * adv_mom_5                           &
-                  +              ibit31 * adv_mom_3                           &
-                     ) *                                                      &
-                                   ( w(k,j+2,i) - w(k,j-1,i) )                &
-              +      (           ibit32 * adv_mom_5                           &
-                     ) *                                                      &
-                                   ( w(k,j+3,i) - w(k,j-2,i) )                &
-                                        )
-!
-!--       k index has to be modified near bottom and top, else array
-!--       subscripts will be exceeded.
-          ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
-          ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
-          ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
-
-          k_ppp = k + 3 * ibit35
-          k_pp  = k + 2 * ( 1 - ibit33  )
-          k_mm  = k - 2 * ibit35
-
-          w_comp    = w(k+1,j,i) + w(k,j,i)
-          flux_t(k) = w_comp  * (                                             &
-                     ( 37.0_wp * ibit35 * adv_mom_5                           &
-                  +     7.0_wp * ibit34 * adv_mom_3                           &
-                  +              ibit33 * adv_mom_1                           &
-                     ) *                                                      &
-                                ( w(k+1,j,i)  + w(k,j,i)     )                &
-              -      (  8.0_wp * ibit35 * adv_mom_5                           &
-                  +              ibit34 * adv_mom_3                           &
-                     ) *                                                      &
-                                ( w(k_pp,j,i)  + w(k-1,j,i)  )                &
-              +      (           ibit35 * adv_mom_5                           &
-                     ) *                                                      &
-                                ( w(k_ppp,j,i) + w(k_mm,j,i) )                &
-                                )
-
-          diss_t(k) = - ABS( w_comp ) * (                                     &
-                     ( 10.0_wp * ibit35 * adv_mom_5                           &
-                  +     3.0_wp * ibit34 * adv_mom_3                           &
-                  +              ibit33 * adv_mom_1                           &
-                     ) *                                                      &
-                                ( w(k+1,j,i)   - w(k,j,i)    )                &
-              -      (  5.0_wp * ibit35 * adv_mom_5                           &
-                  +              ibit34 * adv_mom_3                           &
-                     ) *                                                      &
-                                ( w(k_pp,j,i)  - w(k-1,j,i)  )                &
-              +      (           ibit35 * adv_mom_5                           &
-                     ) *                                                      &
-                                ( w(k_ppp,j,i) - w(k_mm,j,i) )                &
-                                        )
-
-!
-!--       Calculate the divergence of the velocity field. A respective
-!--       correction is needed to overcome numerical instabilities introduced
-!--       by a not sufficient reduction of divergences near topography. 
-          div = ( ( ( u_comp + gu ) * ( ibit27 + ibit28 + ibit29 )            &
-                  - ( u(k+1,j,i) + u(k,j,i)   )                               & 
-                                    * ( IBITS(wall_flags_0(k,j,i-1),27,1)     &
-                                      + IBITS(wall_flags_0(k,j,i-1),28,1)     &
-                                      + IBITS(wall_flags_0(k,j,i-1),29,1)     &
-                                      )                                       &
-                  ) * ddx                                                     &
-              +   ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 )            & 
-                  - ( v(k+1,j,i) + v(k,j,i)   )                               &
-                                    * ( IBITS(wall_flags_0(k,j-1,i),30,1)     &
-                                      + IBITS(wall_flags_0(k,j-1,i),31,1)     &
-                                      + IBITS(wall_flags_00(k,j-1,i),0,1)     &
-                                      )                                       &
-                  ) * ddy                                                     &
-              +   ( w_comp          * ( ibit33 + ibit34 + ibit35 )            &
-                - ( w(k,j,i)   + w(k-1,j,i)   )                               &
-                                    * ( IBITS(wall_flags_00(k-1,j,i),1,1)     &
-                                      + IBITS(wall_flags_00(k-1,j,i),2,1)     &
-                                      + IBITS(wall_flags_00(k-1,j,i),3,1)     &
-                                      )                                       & 
-                  ) * ddzu(k+1)   &
-                ) * 0.5_wp
-
-
-          tend(k,j,i) = tend(k,j,i) - (                                       &
-                      ( flux_r(k) + diss_r(k)                                 &
-                    -   flux_l_w(k,j,tn) - diss_l_w(k,j,tn)   ) * ddx         &
-                    + ( flux_n(k) + diss_n(k)                                 &
-                    -   flux_s_w(k,tn) - diss_s_w(k,tn)       ) * ddy         &
-                    + ( flux_t(k) + diss_t(k)                                 &
-                    -   flux_d    - diss_d                    ) * ddzu(k+1)   &
-                                      ) + div * w(k,j,i)
-
-          flux_l_w(k,j,tn) = flux_r(k)
-          diss_l_w(k,j,tn) = diss_r(k)
-          flux_s_w(k,tn)   = flux_n(k)
-          diss_s_w(k,tn)   = diss_n(k)
-          flux_d           = flux_t(k)
-          diss_d           = diss_t(k)
-!
-!--        Statistical Evaluation of w'w'.
-          sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                          &
-                             + ( flux_t(k) + diss_t(k) )                      &
-                             *   weight_substep(intermediate_timestep_count)
-
-       ENDDO
-
-       DO  k = nzb_max+1, nzt
-
-          u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
-          flux_r(k) = u_comp * (                                              &
-                      37.0_wp * ( w(k,j,i+1) + w(k,j,i)   )                   &
-                    -  8.0_wp * ( w(k,j,i+2) + w(k,j,i-1) )                   &
-                    +           ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_5
-
-          diss_r(k) = - ABS( u_comp ) * (                                     &
-                      10.0_wp * ( w(k,j,i+1) - w(k,j,i)   )                   &
-                    -  5.0_wp * ( w(k,j,i+2) - w(k,j,i-1) )                   &
-                    +           ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_5
-
-          v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
-          flux_n(k) = v_comp * (                                              &
-                      37.0_wp * ( w(k,j+1,i) + w(k,j,i)   )                   &
-                    -  8.0_wp * ( w(k,j+2,i) + w(k,j-1,i) )                   &
-                    +           ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_5
-
-          diss_n(k) = - ABS( v_comp ) * (                                     &
-                      10.0_wp * ( w(k,j+1,i) - w(k,j,i)   )                   &
-                    -  5.0_wp * ( w(k,j+2,i) - w(k,j-1,i) )                   &
-                    +           ( w(k,j+3,i) - w(k,j-2,i) ) ) * adv_mom_5
-!
-!--       k index has to be modified near bottom and top, else array
-!--       subscripts will be exceeded.
-          ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
-          ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
-          ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
-
-          k_ppp = k + 3 * ibit35
-          k_pp  = k + 2 * ( 1 - ibit33  )
-          k_mm  = k - 2 * ibit35
-
-          w_comp    = w(k+1,j,i) + w(k,j,i)
-          flux_t(k) = w_comp  * (                                             &
-                     ( 37.0_wp * ibit35 * adv_mom_5                           &
-                  +     7.0_wp * ibit34 * adv_mom_3                           &
-                  +              ibit33 * adv_mom_1                           &
-                     ) *                                                      &
-                                ( w(k+1,j,i)  + w(k,j,i)     )                &
-              -      (  8.0_wp * ibit35 * adv_mom_5                           &
-                  +              ibit34 * adv_mom_3                           &
-                     ) *                                                      &
-                                ( w(k_pp,j,i)  + w(k-1,j,i)  )                &
-              +      (           ibit35 * adv_mom_5                           &
-                     ) *                                                      &
-                                ( w(k_ppp,j,i) + w(k_mm,j,i) )                &
-                                )
-
-          diss_t(k) = - ABS( w_comp ) * (                                     &
-                     ( 10.0_wp * ibit35 * adv_mom_5                           &
-                  +     3.0_wp * ibit34 * adv_mom_3                           &
-                  +              ibit33 * adv_mom_1                           &
-                     ) *                                                      &
-                                ( w(k+1,j,i)   - w(k,j,i)    )                &
-              -      (  5.0_wp * ibit35 * adv_mom_5                           &
-                  +              ibit34 * adv_mom_3                           &
-                     ) *                                                      &
-                                ( w(k_pp,j,i)  - w(k-1,j,i)  )                &
-              +      (           ibit35 * adv_mom_5                           &
-                     ) *                                                      &
-                                ( w(k_ppp,j,i) - w(k_mm,j,i) )                &
-                                        )
-!
-!--       Calculate the divergence of the velocity field. A respective
-!--       correction is needed to overcome numerical instabilities introduced
-!--       by a not sufficient reduction of divergences near topography.
-          div = ( ( u_comp + gu - ( u(k+1,j,i) + u(k,j,i)   ) ) * ddx         &
-              +   ( v_comp + gv - ( v(k+1,j,i) + v(k,j,i)   ) ) * ddy         &
-              +   ( w_comp      - ( w(k,j,i)   + w(k-1,j,i) ) ) * ddzu(k+1)   &
-                ) * 0.5_wp
-
-          tend(k,j,i) = tend(k,j,i) - (                                       &
-                      ( flux_r(k) + diss_r(k)                                 &
-                    -   flux_l_w(k,j,tn) - diss_l_w(k,j,tn)   ) * ddx         &
-                    + ( flux_n(k) + diss_n(k)                                 &
-                    -   flux_s_w(k,tn) - diss_s_w(k,tn)       ) * ddy         &
-                    + ( flux_t(k) + diss_t(k)                                 &
-                    -   flux_d    - diss_d                    ) * ddzu(k+1)   &
-                                      ) + div * w(k,j,i)
-
-          flux_l_w(k,j,tn) = flux_r(k)
-          diss_l_w(k,j,tn) = diss_r(k)
-          flux_s_w(k,tn)   = flux_n(k)
-          diss_s_w(k,tn)   = diss_n(k)
-          flux_d           = flux_t(k)
-          diss_d           = diss_t(k)
-!
-!--        Statistical Evaluation of w'w'.
-          sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                          &
-                             + ( flux_t(k) + diss_t(k) )                      &
-                             *   weight_substep(intermediate_timestep_count)
-
-       ENDDO
-
-
-    END SUBROUTINE advec_w_ws_ij
-    
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Scalar advection - Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_s_ws( sk, sk_char )
-
-       USE arrays_3d,                                                         &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE constants,                                                         &
-           ONLY:  adv_sca_1, adv_sca_3, adv_sca_5
-
-       USE control_parameters,                                                &
-           ONLY:  intermediate_timestep_count, monotonic_adjustment, u_gtrans,&
-                  v_gtrans 
-
-       USE grid_variables,                                                    &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                           &
-           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max,   &
-                  nzt, wall_flags_0
-           
-       USE kinds
-       
-       USE statistics,                                                        &
-           ONLY:  sums_wspts_ws_l, sums_wsqs_ws_l, sums_wssas_ws_l,           &
-                  sums_wsqrs_ws_l, sums_wsnrs_ws_l, weight_substep
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN = *), INTENT(IN)    ::  sk_char !<
-       
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  ibit0  !<
-       INTEGER(iwp) ::  ibit1  !<
-       INTEGER(iwp) ::  ibit2  !<
-       INTEGER(iwp) ::  ibit3  !<
-       INTEGER(iwp) ::  ibit4  !<
-       INTEGER(iwp) ::  ibit5  !<
-       INTEGER(iwp) ::  ibit6  !<
-       INTEGER(iwp) ::  ibit7  !<
-       INTEGER(iwp) ::  ibit8  !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  k      !<
-       INTEGER(iwp) ::  k_mm   !<
-       INTEGER(iwp) ::  k_mmm  !<
-       INTEGER(iwp) ::  k_pp   !<
-       INTEGER(iwp) ::  k_ppp  !<
-       INTEGER(iwp) ::  tn = 0 !<
-       
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  sk !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  sk !<
-#endif
-
-       REAL(wp) ::  diss_d !<
-       REAL(wp) ::  div    !<
-       REAL(wp) ::  flux_d !<
-       REAL(wp) ::  fd_1   !<
-       REAL(wp) ::  fl_1   !<
-       REAL(wp) ::  fn_1   !<
-       REAL(wp) ::  fr_1   !<
-       REAL(wp) ::  fs_1   !<
-       REAL(wp) ::  ft_1   !<
-       REAL(wp) ::  phi_d  !<
-       REAL(wp) ::  phi_l  !<
-       REAL(wp) ::  phi_n  !<
-       REAL(wp) ::  phi_r  !<
-       REAL(wp) ::  phi_s  !<
-       REAL(wp) ::  phi_t  !<
-       REAL(wp) ::  rd     !<
-       REAL(wp) ::  rl     !<
-       REAL(wp) ::  rn     !<
-       REAL(wp) ::  rr     !<
-       REAL(wp) ::  rs     !<
-       REAL(wp) ::  rt     !<
-       REAL(wp) ::  u_comp !<
-       REAL(wp) ::  v_comp !<
-       
-       REAL(wp), DIMENSION(nzb:nzt)   ::  diss_n !<
-       REAL(wp), DIMENSION(nzb:nzt)   ::  diss_r !<
-       REAL(wp), DIMENSION(nzb:nzt)   ::  diss_t !<
-       REAL(wp), DIMENSION(nzb:nzt)   ::  flux_n !<
-       REAL(wp), DIMENSION(nzb:nzt)   ::  flux_r !<
-       REAL(wp), DIMENSION(nzb:nzt)   ::  flux_t !<
-       
-       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local !<
-       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local !<
-       
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local !<
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local !<
-        
-
-!
-!--    Compute the fluxes for the whole left boundary of the processor domain.
-       i = nxl
-       DO  j = nys, nyn
-
-          DO  k = nzb+1, nzb_max
-
-             ibit2 = IBITS(wall_flags_0(k,j,i-1),2,1)
-             ibit1 = IBITS(wall_flags_0(k,j,i-1),1,1)
-             ibit0 = IBITS(wall_flags_0(k,j,i-1),0,1)
-
-             u_comp                 = u(k,j,i) - u_gtrans
-             swap_flux_x_local(k,j) = u_comp * (                              &
-                                             ( 37.0_wp * ibit2 * adv_sca_5    &
-                                          +     7.0_wp * ibit1 * adv_sca_3    &
-                                          +              ibit0 * adv_sca_1    &
-                                             ) *                              &
-                                          ( sk(k,j,i)   + sk(k,j,i-1)    )    &
-                                      -      (  8.0_wp * ibit2 * adv_sca_5    &
-                                          +              ibit1 * adv_sca_3    &
-                                             ) *                              &
-                                          ( sk(k,j,i+1) + sk(k,j,i-2)    )    &
-                                      +      (           ibit2 * adv_sca_5    & 
-                                             ) *                              &
-                                          ( sk(k,j,i+2) + sk(k,j,i-3)    )    &
-                                               )
-
-              swap_diss_x_local(k,j) = -ABS( u_comp ) * (                     &
-                                             ( 10.0_wp * ibit2 * adv_sca_5    &
-                                          +     3.0_wp * ibit1 * adv_sca_3    &
-                                          +              ibit0 * adv_sca_1    &
-                                             ) *                              &
-                                          ( sk(k,j,i)   - sk(k,j,i-1) )       &
-                                      -      (  5.0_wp * ibit2 * adv_sca_5    &
-                                          +              ibit1 * adv_sca_3    &
-                                             ) *                              &
-                                         ( sk(k,j,i+1) - sk(k,j,i-2)  )       &
-                                      +      (           ibit2 * adv_sca_5    &
-                                             ) *                              &
-                                          ( sk(k,j,i+2) - sk(k,j,i-3) )       &
-                                                        )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             u_comp                 = u(k,j,i) - u_gtrans
-             swap_flux_x_local(k,j) = u_comp * (                              &
-                                      37.0_wp * ( sk(k,j,i)   + sk(k,j,i-1) ) &
-                                    -  8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) ) &
-                                    +           ( sk(k,j,i+2) + sk(k,j,i-3) ) &
-                                               ) * adv_sca_5
-
-             swap_diss_x_local(k,j) = -ABS( u_comp ) * (                      &
-                                      10.0_wp * ( sk(k,j,i)   - sk(k,j,i-1) ) &
-                                    -  5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) ) &
-                                    +           ( sk(k,j,i+2) - sk(k,j,i-3) ) &
-                                                       ) * adv_sca_5
-
-          ENDDO
-
-       ENDDO
-
-       DO  i = nxl, nxr
-
-          j = nys
-          DO  k = nzb+1, nzb_max
-
-             ibit5 = IBITS(wall_flags_0(k,j-1,i),5,1)
-             ibit4 = IBITS(wall_flags_0(k,j-1,i),4,1)
-             ibit3 = IBITS(wall_flags_0(k,j-1,i),3,1)
-
-             v_comp               = v(k,j,i) - v_gtrans
-             swap_flux_y_local(k) = v_comp * (                                &
-                                             ( 37.0_wp * ibit5 * adv_sca_5    &
-                                          +     7.0_wp * ibit4 * adv_sca_3    &
-                                          +              ibit3 * adv_sca_1    &
-                                             ) *                              &
-                                         ( sk(k,j,i)  + sk(k,j-1,i)     )     &
-                                       -     (  8.0_wp * ibit5 * adv_sca_5    &
-                                          +              ibit4 * adv_sca_3    &
-                                              ) *                             &
-                                         ( sk(k,j+1,i) + sk(k,j-2,i)    )     &
-                                      +      (           ibit5 * adv_sca_5    &
-                                             ) *                              &
-                                        ( sk(k,j+2,i) + sk(k,j-3,i)     )     &
-                                             )
-
-             swap_diss_y_local(k) = -ABS( v_comp ) * (                        &
-                                             ( 10.0_wp * ibit5 * adv_sca_5    &
-                                          +     3.0_wp * ibit4 * adv_sca_3    &
-                                          +              ibit3 * adv_sca_1    &
-                                             ) *                              &
-                                          ( sk(k,j,i)   - sk(k,j-1,i)    )    &
-                                      -      (  5.0_wp * ibit5 * adv_sca_5    &
-                                          +              ibit4 * adv_sca_3    &
-                                             ) *                              &
-                                          ( sk(k,j+1,i) - sk(k,j-2,i)    )    &
-                                      +      (           ibit5 * adv_sca_5    &
-                                             ) *                              &
-                                          ( sk(k,j+2,i) - sk(k,j-3,i)    )    &
-                                                     )
-
-          ENDDO
-!
-!--       Above to the top of the highest topography. No degradation necessary.
-          DO  k = nzb_max+1, nzt
-
-             v_comp               = v(k,j,i) - v_gtrans
-             swap_flux_y_local(k) = v_comp * (                               &
-                                    37.0_wp * ( sk(k,j,i)   + sk(k,j-1,i) )  &
-                                  -  8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) )  &
-                                  +           ( sk(k,j+2,i) + sk(k,j-3,i) )  &
-                                             ) * adv_sca_5
-              swap_diss_y_local(k) = -ABS( v_comp ) * (                      &
-                                    10.0_wp * ( sk(k,j,i)   - sk(k,j-1,i) )  &
-                                  -  5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) )  &
-                                  +             sk(k,j+2,i) - sk(k,j-3,i)    &
-                                                      ) * adv_sca_5
-
-          ENDDO
-
-          DO  j = nys, nyn
-
-             flux_t(0) = 0.0_wp
-             diss_t(0) = 0.0_wp
-             flux_d    = 0.0_wp
-             diss_d    = 0.0_wp
-
-             DO  k = nzb+1, nzb_max
-
-                ibit2 = IBITS(wall_flags_0(k,j,i),2,1)
-                ibit1 = IBITS(wall_flags_0(k,j,i),1,1)
-                ibit0 = IBITS(wall_flags_0(k,j,i),0,1)
-
-                u_comp    = u(k,j,i+1) - u_gtrans
-                flux_r(k) = u_comp * (                                        &
-                          ( 37.0_wp * ibit2 * adv_sca_5                       &
-                      +      7.0_wp * ibit1 * adv_sca_3                       &
-                      +               ibit0 * adv_sca_1                       &
-                          ) *                                                 &
-                             ( sk(k,j,i+1) + sk(k,j,i)   )                    &
-                   -      (  8.0_wp * ibit2 * adv_sca_5                       &
-                       +              ibit1 * adv_sca_3                       &
-                          ) *                                                 &
-                             ( sk(k,j,i+2) + sk(k,j,i-1) )                    &
-                   +      (           ibit2 * adv_sca_5                       &
-                          ) *                                                 &
-                             ( sk(k,j,i+3) + sk(k,j,i-2) )                    &
-                                     )
-
-                diss_r(k) = -ABS( u_comp ) * (                                &
-                          ( 10.0_wp * ibit2 * adv_sca_5                       &
-                       +     3.0_wp * ibit1 * adv_sca_3                       &
-                       +              ibit0 * adv_sca_1                       &
-                          ) *                                                 &
-                             ( sk(k,j,i+1) - sk(k,j,i)   )                    &
-                   -      (  5.0_wp * ibit2 * adv_sca_5                       &
-                       +              ibit1 * adv_sca_3                       &
-                          ) *                                                 &
-                             ( sk(k,j,i+2) - sk(k,j,i-1) )                    &
-                   +      (           ibit2 * adv_sca_5                       &
-                          ) *                                                 &
-                             ( sk(k,j,i+3) - sk(k,j,i-2) )                    &
-                                             )
-
-                ibit5 = IBITS(wall_flags_0(k,j,i),5,1)
-                ibit4 = IBITS(wall_flags_0(k,j,i),4,1)
-                ibit3 = IBITS(wall_flags_0(k,j,i),3,1)
-
-                v_comp    = v(k,j+1,i) - v_gtrans
-                flux_n(k) = v_comp * (                                        &
-                          ( 37.0_wp * ibit5 * adv_sca_5                       &
-                       +     7.0_wp * ibit4 * adv_sca_3                       &
-                       +              ibit3 * adv_sca_1                       &
-                          ) *                                                 &
-                             ( sk(k,j+1,i) + sk(k,j,i)   )                    &
-                   -      (  8.0_wp * ibit5 * adv_sca_5                       &
-                       +              ibit4 * adv_sca_3                       &
-                          ) *                                                 &
-                             ( sk(k,j+2,i) + sk(k,j-1,i) )                    &
-                   +      (           ibit5 * adv_sca_5                       &
-                          ) *                                                 &
-                             ( sk(k,j+3,i) + sk(k,j-2,i) )                    &
-                                     )
-
-                diss_n(k) = -ABS( v_comp ) * (                                &
-                          ( 10.0_wp * ibit5 * adv_sca_5                       &
-                       +     3.0_wp * ibit4 * adv_sca_3                       &
-                       +              ibit3 * adv_sca_1                       &
-                          ) *                                                 &
-                             ( sk(k,j+1,i) - sk(k,j,i)    )                   &
-                   -      (  5.0_wp * ibit5 * adv_sca_5                       &
-                       +              ibit4 * adv_sca_3                       &
-                          ) *                                                 &
-                             ( sk(k,j+2,i) - sk(k,j-1,i)  )                   &
-                   +      (           ibit5 * adv_sca_5                       &
-                          ) *                                                 &
-                             ( sk(k,j+3,i) - sk(k,j-2,i) )                    &
-                                             )
-!
-!--             k index has to be modified near bottom and top, else array
-!--             subscripts will be exceeded.
-                ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
-                ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
-                ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
-
-                k_ppp = k + 3 * ibit8
-                k_pp  = k + 2 * ( 1 - ibit6  )
-                k_mm  = k - 2 * ibit8
-
-
-                flux_t(k) = w(k,j,i) * (                                      &
-                           ( 37.0_wp * ibit8 * adv_sca_5                      &
-                        +     7.0_wp * ibit7 * adv_sca_3                      &
-                        +           ibit6 * adv_sca_1                         &
-                           ) *                                                &
-                                   ( sk(k+1,j,i)  + sk(k,j,i)    )            &
-                    -      (  8.0_wp * ibit8 * adv_sca_5                      &
-                        +              ibit7 * adv_sca_3                      &
-                           ) *                                                &
-                                   ( sk(k_pp,j,i) + sk(k-1,j,i)  )            &
-                    +      (           ibit8 * adv_sca_5                      &
-                           ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )            &
-                                       )
-
-                diss_t(k) = -ABS( w(k,j,i) ) * (                              &
-                           ( 10.0_wp * ibit8 * adv_sca_5                      &
-                        +     3.0_wp * ibit7 * adv_sca_3                      &
-                        +              ibit6 * adv_sca_1                      &
-                           ) *                                                &
-                                   ( sk(k+1,j,i)   - sk(k,j,i)    )           &
-                    -      (  5.0_wp * ibit8 * adv_sca_5                      &
-                        +              ibit7 * adv_sca_3                      &
-                           ) *                                                &
-                                   ( sk(k_pp,j,i)  - sk(k-1,j,i)  )           &
-                    +      (           ibit8 * adv_sca_5                      &
-                           ) *                                                &
-                                   ( sk(k_ppp,j,i) - sk(k_mm,j,i) )           &
-                                               )
-!
-!--             Apply monotonic adjustment.
-                IF ( monotonic_adjustment )  THEN
-!
-!--                At first, calculate first order fluxes.
-                   u_comp = u(k,j,i) - u_gtrans
-                   fl_1   =  ( u_comp   * ( sk(k,j,i) + sk(k,j,i-1) )         &
-                         -ABS( u_comp ) * ( sk(k,j,i) - sk(k,j,i-1) )         &
-                             ) * adv_sca_1 
-
-                   u_comp = u(k,j,i+1) - u_gtrans
-                   fr_1   =  ( u_comp   * ( sk(k,j,i+1) + sk(k,j,i) )         &
-                         -ABS( u_comp ) * ( sk(k,j,i+1) - sk(k,j,i) )         &
-                             ) * adv_sca_1 
-
-                   v_comp = v(k,j,i) - v_gtrans
-                   fs_1   =  ( v_comp   * ( sk(k,j,i) + sk(k,j-1,i) )         &
-                         -ABS( v_comp ) * ( sk(k,j,i) - sk(k,j-1,i) )         &
-                             ) * adv_sca_1 
-
-                   v_comp = v(k,j+1,i) - v_gtrans
-                   fn_1   =  ( v_comp   * ( sk(k,j+1,i) + sk(k,j,i) )         &
-                         -ABS( v_comp ) * ( sk(k,j+1,i) - sk(k,j,i) )         &
-                             ) * adv_sca_1 
-
-                   fd_1   = (  w(k-1,j,i)   * ( sk(k,j,i) + sk(k-1,j,i) )     &
-                         -ABS( w(k-1,j,i) ) * ( sk(k,j,i) - sk(k-1,j,i) )     &
-                            ) * adv_sca_1 
-
-                   ft_1   = (  w(k,j,i)   * ( sk(k+1,j,i) + sk(k,j,i) )       &
-                         -ABS( w(k,j,i) ) * ( sk(k+1,j,i) - sk(k,j,i) )       &
-                            ) * adv_sca_1 
-!
-!--                Calculate ratio of upwind gradients. Note, Min/Max is just
-!--                to avoid if statements.
-                   rl     = ( MAX( 0.0_wp, u(k,j,i) - u_gtrans ) *            & 
-                               ABS( ( sk(k,j,i-1) - sk(k,j,i-2)            ) /&
-                                    ( sk(k,j,i)   - sk(k,j,i-1) + 1E-20_wp )  &
-                                  ) +                                         & 
-                              MIN( 0.0_wp, u(k,j,i) - u_gtrans ) *            &
-                               ABS( ( sk(k,j,i)   - sk(k,j,i+1)            ) /&
-                                    ( sk(k,j,i-1) - sk(k,j,i)   + 1E-20_wp )  &
-                                  )                                           &
-                            ) / ABS( u(k,j,i) - u_gtrans + 1E-20_wp )
-
-                   rr     = ( MAX( 0.0_wp, u(k,j,i+1) - u_gtrans ) *          & 
-                               ABS( ( sk(k,j,i)   - sk(k,j,i-1)            ) /&
-                                    ( sk(k,j,i+1) - sk(k,j,i)   + 1E-20_wp )  &
-                                  ) +                                         & 
-                              MIN( 0.0_wp, u(k,j,i+1) - u_gtrans ) *          &
-                               ABS( ( sk(k,j,i+1) - sk(k,j,i+2)            ) /&
-                                    ( sk(k,j,i)   - sk(k,j,i+1) + 1E-20_wp )  &
-                                  )                                           &
-                            ) / ABS( u(k,j,i+1) - u_gtrans + 1E-20_wp )
-
-                   rs     = ( MAX( 0.0_wp, v(k,j,i) - v_gtrans ) *            & 
-                               ABS( ( sk(k,j-1,i) - sk(k,j-2,i)            ) /&
-                                    ( sk(k,j,i)   - sk(k,j-1,i) + 1E-20_wp )  &
-                                  ) +                                         & 
-                              MIN( 0.0_wp, v(k,j,i) - v_gtrans ) *            &
-                               ABS( ( sk(k,j,i)   - sk(k,j+1,i)            ) /&
-                                    ( sk(k,j-1,i) - sk(k,j,i)   + 1E-20_wp )  &
-                                  )                                           &
-                            ) / ABS( v(k,j,i) - v_gtrans + 1E-20_wp )
-
-                   rn     = ( MAX( 0.0_wp, v(k,j+1,i) - v_gtrans ) *          & 
-                               ABS( ( sk(k,j,i)   - sk(k,j-1,i)            ) /&
-                                    ( sk(k,j+1,i) - sk(k,j,i)   + 1E-20_wp )  &
-                                  ) +                                         & 
-                              MIN( 0.0_wp, v(k,j+1,i) - v_gtrans ) *          &
-                               ABS( ( sk(k,j+1,i) - sk(k,j+2,i)            ) /&
-                                    ( sk(k,j,i)   - sk(k,j+1,i) + 1E-20_wp )  &
-                                  )                                           &
-                            ) / ABS( v(k,j+1,i) - v_gtrans + 1E-20_wp )     
-!   
-!--                Reuse k_mm and compute k_mmm for the vertical gradient ratios. 
-!--                Note, for vertical advection below the third grid point above 
-!--                surface ( or below the model top) rd and rt are set to 0, i.e. 
-!--                use of first order scheme is enforced.
-                   k_mmm  = k - 3 * ibit8
-
-                   rd     = ( MAX( 0.0_wp, w(k-1,j,i) ) *                     & 
-                            ABS( ( sk(k_mm,j,i) - sk(k_mmm,j,i)           ) / &
-                                 ( sk(k-1,j,i)  - sk(k_mm,j,i) + 1E-20_wp )   &
-                               ) +                                            & 
-                              MIN( 0.0_wp, w(k-1,j,i) ) *                     &
-                            ABS( ( sk(k-1,j,i) - sk(k,j,i)            ) /     &
-                                 ( sk(k_mm,j,i) - sk(k-1,j,i)   + 1E-20_wp )  &
-                               )                                              &
-                            ) * ibit8 / ABS( w(k-1,j,i) + 1E-20_wp ) 
- 
-                   rt     = ( MAX( 0.0_wp, w(k,j,i) ) *                       & 
-                            ABS( ( sk(k,j,i)   - sk(k-1,j,i)            ) /   &
-                                 ( sk(k+1,j,i) - sk(k,j,i)   + 1E-20_wp )     &
-                               ) +                                            & 
-                              MIN( 0.0_wp, w(k,j,i) ) *                       &
-                            ABS( ( sk(k+1,j,i) - sk(k_pp,j,i)           ) /   &
-                                 ( sk(k,j,i)   - sk(k+1,j,i) + 1E-20_wp )     &
-                               )                                              &
-                            ) * ibit8 / ABS( w(k,j,i) + 1E-20_wp )
-!
-!--                Calculate empirical limiter function (van Albada2 limiter).
-                   phi_l = MIN( 1.0_wp, ( 2.0_wp * ABS( rl ) ) /              &
-                                        ( rl**2 + 1.0_wp ) ) 
-                   phi_r = MIN( 1.0_wp, ( 2.0_wp * ABS( rr ) ) /              &
-                                        ( rr**2 + 1.0_wp ) ) 
-                   phi_s = MIN( 1.0_wp, ( 2.0_wp * ABS( rs ) ) /              &
-                                        ( rs**2 + 1.0_wp ) ) 
-                   phi_n = MIN( 1.0_wp, ( 2.0_wp * ABS( rn ) ) /              &
-                                        ( rn**2 + 1.0_wp ) ) 
-                   phi_d = MIN( 1.0_wp, ( 2.0_wp * ABS( rd ) ) /              &
-                                        ( rd**2 + 1.0_wp ) ) 
-                   phi_t = MIN( 1.0_wp, ( 2.0_wp * ABS( rt ) ) /              &
-                                        ( rt**2 + 1.0_wp ) ) 
-!
-!--                Calculate the resulting monotone flux. 
-                   swap_flux_x_local(k,j) = fl_1 - phi_l *                    &
-                                          ( fl_1 - swap_flux_x_local(k,j) )
-                   flux_r(k)              = fr_1 - phi_r *                    &
-                                          ( fr_1 - flux_r(k)              )
-                   swap_flux_y_local(k)   = fs_1 - phi_s *                    &
-                                          ( fs_1 - swap_flux_y_local(k)   )
-                   flux_n(k)              = fn_1 - phi_n *                    &
-                                          ( fn_1 - flux_n(k)              )
-                   flux_d                 = fd_1 - phi_d *                    &
-                                          ( fd_1 - flux_d                 )
-                   flux_t(k)              = ft_1 - phi_t *                    &
-                                          ( ft_1 - flux_t(k)              )
-!
-!--                Moreover, modify dissipation flux according to the limiter. 
-                   swap_diss_x_local(k,j) = swap_diss_x_local(k,j) * phi_l
-                   diss_r(k)              = diss_r(k)              * phi_r
-                   swap_diss_y_local(k)   = swap_diss_y_local(k)   * phi_s
-                   diss_n(k)              = diss_n(k)              * phi_n
-                   diss_d                 = diss_d                 * phi_d
-                   diss_t(k)              = diss_t(k)              * phi_t
-
-                ENDIF
-!
-!--             Calculate the divergence of the velocity field. A respective
-!--             correction is needed to overcome numerical instabilities caused
-!--             by a not sufficient reduction of divergences near topography.
-                div   =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )             &
-                          - u(k,j,i)   * ( IBITS(wall_flags_0(k,j,i-1),0,1)    &
-                                         + IBITS(wall_flags_0(k,j,i-1),1,1)    &
-                                         + IBITS(wall_flags_0(k,j,i-1),2,1)    &
-                                         )                                     &
-                          ) * ddx                                              &
-                        + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )             &
-                          - v(k,j,i)   * ( IBITS(wall_flags_0(k,j-1,i),3,1)    &
-                                         + IBITS(wall_flags_0(k,j-1,i),4,1)    &
-                                         + IBITS(wall_flags_0(k,j-1,i),5,1)    &
-                                         )                                     &
-                          ) * ddy                                              &
-                        + ( w(k,j,i)   * ( ibit6 + ibit7 + ibit8 )             &
-                          - w(k-1,j,i) * ( IBITS(wall_flags_0(k-1,j,i),6,1)    &
-                                         + IBITS(wall_flags_0(k-1,j,i),7,1)    &
-                                         + IBITS(wall_flags_0(k-1,j,i),8,1)    &
-                                         )                                     &      
-                          ) * ddzw(k)
-
-
-                tend(k,j,i) = tend(k,j,i) - (                                 &
-                        ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j) -    &
-                          swap_diss_x_local(k,j)            ) * ddx           &
-                      + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k)   -    &
-                          swap_diss_y_local(k)              ) * ddy           &
-                      + ( flux_t(k) + diss_t(k) - flux_d - diss_d             &
-                                                               ) * ddzw(k)    &
-                                            ) + sk(k,j,i) * div
-
-                swap_flux_y_local(k)   = flux_n(k)
-                swap_diss_y_local(k)   = diss_n(k)
-                swap_flux_x_local(k,j) = flux_r(k)
-                swap_diss_x_local(k,j) = diss_r(k)
-                flux_d                 = flux_t(k)
-                diss_d                 = diss_t(k)
-
-             ENDDO
-
-             DO  k = nzb_max+1, nzt
-
-                u_comp    = u(k,j,i+1) - u_gtrans
-                flux_r(k) = u_comp * (                                        &
-                      37.0_wp * ( sk(k,j,i+1) + sk(k,j,i)   )                 &
-                    -  8.0_wp * ( sk(k,j,i+2) + sk(k,j,i-1) )                 &
-                    +           ( sk(k,j,i+3) + sk(k,j,i-2) ) ) * adv_sca_5
-                diss_r(k) = -ABS( u_comp ) * (                                &
-                      10.0_wp * ( sk(k,j,i+1) - sk(k,j,i)   )                 &
-                    -  5.0_wp * ( sk(k,j,i+2) - sk(k,j,i-1) )                 &
-                    +           ( sk(k,j,i+3) - sk(k,j,i-2) ) ) * adv_sca_5
-
-                v_comp    = v(k,j+1,i) - v_gtrans
-                flux_n(k) = v_comp * (                                        &
-                      37.0_wp * ( sk(k,j+1,i) + sk(k,j,i)   )                 &
-                    -  8.0_wp * ( sk(k,j+2,i) + sk(k,j-1,i) )                 &
-                    +           ( sk(k,j+3,i) + sk(k,j-2,i) ) ) * adv_sca_5
-                diss_n(k) = -ABS( v_comp ) * (                                &
-                      10.0_wp * ( sk(k,j+1,i) - sk(k,j,i)   )                 &
-                    -  5.0_wp * ( sk(k,j+2,i) - sk(k,j-1,i) )                 &
-                    +           ( sk(k,j+3,i) - sk(k,j-2,i) ) ) * adv_sca_5
-!
-!--             k index has to be modified near bottom and top, else array
-!--             subscripts will be exceeded.
-                ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
-                ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
-                ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
-
-                k_ppp = k + 3 * ibit8
-                k_pp  = k + 2 * ( 1 - ibit6  )
-                k_mm  = k - 2 * ibit8
-
-
-                flux_t(k) = w(k,j,i) * (                                      &
-                           ( 37.0_wp * ibit8 * adv_sca_5                      &
-                        +     7.0_wp * ibit7 * adv_sca_3                      &
-                        +              ibit6 * adv_sca_1                      &
-                           ) *                                                &
-                                   ( sk(k+1,j,i)  + sk(k,j,i)     )           &
-                    -      (  8.0_wp * ibit8 * adv_sca_5                      &
-                        +              ibit7 * adv_sca_3                      &
-                           ) *                                                &
-                                   ( sk(k_pp,j,i) + sk(k-1,j,i)   )           &
-                    +      (           ibit8 * adv_sca_5                      &
-                           ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i)  )           &
-                                       )
-
-                diss_t(k) = -ABS( w(k,j,i) ) * (                              &
-                           ( 10.0_wp * ibit8 * adv_sca_5                      &
-                        +     3.0_wp * ibit7 * adv_sca_3                      &
-                        +              ibit6 * adv_sca_1                      &
-                           ) *                                                &
-                                   ( sk(k+1,j,i)   - sk(k,j,i)    )           &
-                    -      (  5.0_wp * ibit8 * adv_sca_5                      &
-                        +              ibit7 * adv_sca_3                      &
-                           ) *                                                &
-                                   ( sk(k_pp,j,i)  - sk(k-1,j,i)  )           &
-                    +      (           ibit8 * adv_sca_5                      &
-                           ) *                                                &
-                                   ( sk(k_ppp,j,i) - sk(k_mm,j,i) )           &
-                                               )
-!
-!--             Apply monotonic adjustment.
-                IF ( monotonic_adjustment )  THEN
-!
-!--                At first, calculate first order fluxes.
-                   u_comp = u(k,j,i) - u_gtrans
-                   fl_1   =  ( u_comp   * ( sk(k,j,i) + sk(k,j,i-1) )         &
-                         -ABS( u_comp ) * ( sk(k,j,i) - sk(k,j,i-1) )         &
-                             ) * adv_sca_1 
-
-                   u_comp = u(k,j,i+1) - u_gtrans
-                   fr_1   =  ( u_comp   * ( sk(k,j,i+1) + sk(k,j,i) )         &
-                         -ABS( u_comp ) * ( sk(k,j,i+1) - sk(k,j,i) )         &
-                             ) * adv_sca_1 
-
-                   v_comp = v(k,j,i) - v_gtrans
-                   fs_1   =  ( v_comp   * ( sk(k,j,i) + sk(k,j-1,i) )         &
-                         -ABS( v_comp ) * ( sk(k,j,i) - sk(k,j-1,i) )         &
-                             ) * adv_sca_1 
-
-                   v_comp = v(k,j+1,i) - v_gtrans
-                   fn_1   =  ( v_comp   * ( sk(k,j+1,i) + sk(k,j,i) )         &
-                         -ABS( v_comp ) * ( sk(k,j+1,i) - sk(k,j,i) )         &
-                             ) * adv_sca_1 
-
-                   fd_1   = (  w(k-1,j,i)   * ( sk(k,j,i) + sk(k-1,j,i) )     &
-                         -ABS( w(k-1,j,i) ) * ( sk(k,j,i) - sk(k-1,j,i) )     &
-                            ) * adv_sca_1 
-
-                   ft_1   = (  w(k,j,i)   * ( sk(k+1,j,i) + sk(k,j,i) )       &
-                         -ABS( w(k,j,i) ) * ( sk(k+1,j,i) - sk(k,j,i) )       &
-                            ) * adv_sca_1 
-!
-!--                Calculate ratio of upwind gradients. Note, Min/Max is just
-!--                to avoid if statements.
-                   rl     = ( MAX( 0.0_wp, u(k,j,i) - u_gtrans ) *            & 
-                               ABS( ( sk(k,j,i-1) - sk(k,j,i-2)            ) /&
-                                    ( sk(k,j,i)   - sk(k,j,i-1) + 1E-20_wp )  &
-                                  ) +                                         & 
-                              MIN( 0.0_wp, u(k,j,i) - u_gtrans ) *            &
-                               ABS( ( sk(k,j,i)   - sk(k,j,i+1)            ) /&
-                                    ( sk(k,j,i-1) - sk(k,j,i)   + 1E-20_wp )  &
-                                  )                                           &
-                            ) / ABS( u(k,j,i) - u_gtrans + 1E-20_wp )
-
-                   rr     = ( MAX( 0.0_wp, u(k,j,i+1) - u_gtrans ) *          & 
-                               ABS( ( sk(k,j,i)   - sk(k,j,i-1)            ) /&
-                                    ( sk(k,j,i+1) - sk(k,j,i)   + 1E-20_wp )  &
-                                  ) +                                         & 
-                              MIN( 0.0_wp, u(k,j,i+1) - u_gtrans ) *          &
-                               ABS( ( sk(k,j,i+1) - sk(k,j,i+2)            ) /&
-                                    ( sk(k,j,i)   - sk(k,j,i+1) + 1E-20_wp )  &
-                                  )                                           &
-                            ) / ABS( u(k,j,i+1) - u_gtrans + 1E-20_wp )
-
-                   rs     = ( MAX( 0.0_wp, v(k,j,i) - v_gtrans ) *            & 
-                               ABS( ( sk(k,j-1,i) - sk(k,j-2,i)            ) /&
-                                    ( sk(k,j,i)   - sk(k,j-1,i) + 1E-20_wp )  &
-                                  ) +                                         & 
-                              MIN( 0.0_wp, v(k,j,i) - v_gtrans ) *            &
-                               ABS( ( sk(k,j,i)   - sk(k,j+1,i)            ) /&
-                                    ( sk(k,j-1,i) - sk(k,j,i)   + 1E-20_wp )  &
-                                  )                                           &
-                            ) / ABS( v(k,j,i) - v_gtrans + 1E-20_wp )
-
-                   rn     = ( MAX( 0.0_wp, v(k,j+1,i) - v_gtrans ) *          & 
-                               ABS( ( sk(k,j,i)   - sk(k,j-1,i)            ) /&
-                                    ( sk(k,j+1,i) - sk(k,j,i)   + 1E-20_wp )  &
-                                  ) +                                         & 
-                              MIN( 0.0_wp, v(k,j+1,i) - v_gtrans ) *          &
-                               ABS( ( sk(k,j+1,i) - sk(k,j+2,i)            ) /&
-                                    ( sk(k,j,i)   - sk(k,j+1,i) + 1E-20_wp )  &
-                                  )                                           &
-                            ) / ABS( v(k,j+1,i) - v_gtrans + 1E-20_wp )     
-!   
-!--                Reuse k_mm and compute k_mmm for the vertical gradient ratios. 
-!--                Note, for vertical advection below the third grid point above 
-!--                surface ( or below the model top) rd and rt are set to 0, i.e. 
-!--                use of first order scheme is enforced.
-                   k_mmm  = k - 3 * ibit8
-
-                   rd     = ( MAX( 0.0_wp, w(k-1,j,i) ) *                     & 
-                            ABS( ( sk(k_mm,j,i) - sk(k_mmm,j,i)           ) / &
-                                 ( sk(k-1,j,i)  - sk(k_mm,j,i) + 1E-20_wp )   &
-                               ) +                                            & 
-                              MIN( 0.0_wp, w(k-1,j,i) ) *                     &
-                            ABS( ( sk(k-1,j,i) - sk(k,j,i)            ) /     &
-                                 ( sk(k_mm,j,i) - sk(k-1,j,i)   + 1E-20_wp )  &
-                               )                                              &
-                            ) * ibit8 / ABS( w(k-1,j,i) + 1E-20_wp ) 
- 
-                   rt     = ( MAX( 0.0_wp, w(k,j,i) ) *                       & 
-                            ABS( ( sk(k,j,i)   - sk(k-1,j,i)            ) /   &
-                                 ( sk(k+1,j,i) - sk(k,j,i)   + 1E-20_wp )     &
-                               ) +                                            & 
-                              MIN( 0.0_wp, w(k,j,i) ) *                       &
-                            ABS( ( sk(k+1,j,i) - sk(k_pp,j,i)           ) /   &
-                                 ( sk(k,j,i)   - sk(k+1,j,i) + 1E-20_wp )     &
-                               )                                              &
-                            ) * ibit8 / ABS( w(k,j,i) + 1E-20_wp ) 
-!
-!--                Calculate empirical limiter function (van Albada2 limiter).
-                   phi_l = MIN( 1.0_wp, ( 2.0_wp * ABS( rl ) ) /              &
-                                        ( rl**2 + 1.0_wp ) ) 
-                   phi_r = MIN( 1.0_wp, ( 2.0_wp * ABS( rr ) ) /              &
-                                        ( rr**2 + 1.0_wp ) ) 
-                   phi_s = MIN( 1.0_wp, ( 2.0_wp * ABS( rs ) ) /              &
-                                        ( rs**2 + 1.0_wp ) ) 
-                   phi_n = MIN( 1.0_wp, ( 2.0_wp * ABS( rn ) ) /              &
-                                        ( rn**2 + 1.0_wp ) ) 
-                   phi_d = MIN( 1.0_wp, ( 2.0_wp * ABS( rd ) ) /              &
-                                        ( rd**2 + 1.0_wp ) ) 
-                   phi_t = MIN( 1.0_wp, ( 2.0_wp * ABS( rt ) ) /              &
-                                        ( rt**2 + 1.0_wp ) ) 
-!
-!--                Calculate the resulting monotone flux. 
-                   swap_flux_x_local(k,j) = fl_1 - phi_l *                    &
-                                          ( fl_1 - swap_flux_x_local(k,j) )
-                   flux_r(k)              = fr_1 - phi_r *                    &
-                                          ( fr_1 - flux_r(k)              )
-                   swap_flux_y_local(k)   = fs_1 - phi_s *                    &
-                                          ( fs_1 - swap_flux_y_local(k)   )
-                   flux_n(k)              = fn_1 - phi_n *                    &
-                                          ( fn_1 - flux_n(k)              )
-                   flux_d                 = fd_1 - phi_d *                    &
-                                          ( fd_1 - flux_d                 )
-                   flux_t(k)              = ft_1 - phi_t *                    &
-                                          ( ft_1 - flux_t(k)              )
-!
-!--                Moreover, modify dissipation flux according to the limiter. 
-                   swap_diss_x_local(k,j) = swap_diss_x_local(k,j) * phi_l
-                   diss_r(k)              = diss_r(k)              * phi_r
-                   swap_diss_y_local(k)   = swap_diss_y_local(k)   * phi_s
-                   diss_n(k)              = diss_n(k)              * phi_n
-                   diss_d                 = diss_d                 * phi_d
-                   diss_t(k)              = diss_t(k)              * phi_t
-
-                ENDIF
-!
-!--             Calculate the divergence of the velocity field. A respective
-!--             correction is needed to overcome numerical instabilities introduced
-!--             by a not sufficient reduction of divergences near topography.
-                div         =   ( u(k,j,i+1) - u(k,j,i)   ) * ddx             &
-                              + ( v(k,j+1,i) - v(k,j,i)   ) * ddy             &
-                              + ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)
-
-                tend(k,j,i) = tend(k,j,i) - (                                 &
-                        ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j) -    &
-                          swap_diss_x_local(k,j)            ) * ddx           &
-                      + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k)   -    &
-                          swap_diss_y_local(k)              ) * ddy           &
-                      + ( flux_t(k) + diss_t(k) - flux_d - diss_d             &
-                                                               ) * ddzw(k)    &
-                                            ) + sk(k,j,i) * div
-
-                swap_flux_y_local(k)   = flux_n(k)
-                swap_diss_y_local(k)   = diss_n(k)
-                swap_flux_x_local(k,j) = flux_r(k)
-                swap_diss_x_local(k,j) = diss_r(k)
-                flux_d                 = flux_t(k)
-                diss_d                 = diss_t(k)
-
-             ENDDO
-!
-!--          Evaluation of statistics. 
-             SELECT CASE ( sk_char )
-
-                 CASE ( 'pt' )
-                    DO  k = nzb, nzt
-                       sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn)          &
-                        + ( flux_t(k) + diss_t(k) )                           &
-                        *   weight_substep(intermediate_timestep_count)
-                    ENDDO
-                 CASE ( 'sa' )
-                    DO  k = nzb, nzt
-                       sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn)          &
-                        + ( flux_t(k) + diss_t(k) )                           &
-                        *   weight_substep(intermediate_timestep_count)
-                    ENDDO
-                 CASE ( 'q' )
-                    DO  k = nzb, nzt
-                       sums_wsqs_ws_l(k,tn) = sums_wsqs_ws_l(k,tn)            &
-                        + ( flux_t(k) + diss_t(k) )                           &
-                        *   weight_substep(intermediate_timestep_count)
-                    ENDDO
-                 CASE ( 'qr' )
-                    DO  k = nzb, nzt
-                       sums_wsqrs_ws_l(k,tn) = sums_wsqrs_ws_l(k,tn)          &
-                        + ( flux_t(k) + diss_t(k) )                           &
-                        *   weight_substep(intermediate_timestep_count)
-                    ENDDO
-                 CASE ( 'nr' )
-                    DO  k = nzb, nzt
-                       sums_wsnrs_ws_l(k,tn) = sums_wsnrs_ws_l(k,tn)          &
-                        + ( flux_t(k) + diss_t(k) )                           &
-                        *   weight_substep(intermediate_timestep_count)
-                    ENDDO
-
-              END SELECT
-
-         ENDDO
-      ENDDO
-
-    END SUBROUTINE advec_s_ws
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Scalar advection - Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_s_ws_acc ( sk, sk_char )
-
-       USE arrays_3d,                                                         &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE constants,                                                         &
-           ONLY:  adv_sca_1, adv_sca_3, adv_sca_5
-
-       USE control_parameters,                                                &
-           ONLY:  intermediate_timestep_count, monotonic_adjustment, u_gtrans,&
-                  v_gtrans
-
-       USE grid_variables,                                                    &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                           &
-           ONLY:  i_left, i_right, j_north, j_south, nxlg, nxrg, nyng, nysg,  &
-                  nzb, nzb_max, nzt, wall_flags_0
-
-       USE kinds
-       
-!        USE statistics,                                                       &
-!            ONLY:  sums_wspts_ws_l, sums_wsqs_ws_l, sums_wssas_ws_l,          &
-!                   sums_wsqrs_ws_l, sums_wsnrs_ws_l, weight_substep
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN = *), INTENT(IN)    :: sk_char !<
-
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  ibit0  !<
-       INTEGER(iwp) ::  ibit1  !<
-       INTEGER(iwp) ::  ibit2  !<
-       INTEGER(iwp) ::  ibit3  !<
-       INTEGER(iwp) ::  ibit4  !<
-       INTEGER(iwp) ::  ibit5  !<
-       INTEGER(iwp) ::  ibit6  !<
-       INTEGER(iwp) ::  ibit7  !<
-       INTEGER(iwp) ::  ibit8  !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  k      !<
-       INTEGER(iwp) ::  k_mm   !<
-       INTEGER(iwp) ::  k_mmm  !<
-       INTEGER(iwp) ::  k_pp   !<
-       INTEGER(iwp) ::  k_ppp  !<
-       INTEGER(iwp) ::  tn = 0 !<
-
-       REAL(wp)    ::  diss_d !<
-       REAL(wp)    ::  diss_l !<
-       REAL(wp)    ::  diss_n !<
-       REAL(wp)    ::  diss_r !<
-       REAL(wp)    ::  diss_s !<
-       REAL(wp)    ::  diss_t !<
-       REAL(wp)    ::  div    !<
-       REAL(wp)    ::  flux_d !<
-       REAL(wp)    ::  flux_l !<
-       REAL(wp)    ::  flux_n !<
-       REAL(wp)    ::  flux_r !<
-       REAL(wp)    ::  flux_s !<
-       REAL(wp)    ::  flux_t !<
-       REAL(wp)    ::  fd_1   !<
-       REAL(wp)    ::  fl_1   !<
-       REAL(wp)    ::  fn_1   !<
-       REAL(wp)    ::  fr_1   !<
-       REAL(wp)    ::  fs_1   !<
-       REAL(wp)    ::  ft_1   !<
-       REAL(wp)    ::  phi_d  !<
-       REAL(wp)    ::  phi_l  !<
-       REAL(wp)    ::  phi_n  !<
-       REAL(wp)    ::  phi_r  !<
-       REAL(wp)    ::  phi_s  !<
-       REAL(wp)    ::  phi_t  !<
-       REAL(wp)    ::  rd     !<
-       REAL(wp)    ::  rl     !<
-       REAL(wp)    ::  rn     !<
-       REAL(wp)    ::  rr     !<
-       REAL(wp)    ::  rs     !<
-       REAL(wp)    ::  rt     !<
-       REAL(wp)    ::  u_comp !<
-       REAL(wp)    ::  v_comp !<
-
-       REAL(wp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  ::  sk !<
-
-!
-!--    Computation of fluxes and tendency terms
-       !$acc kernels present( ddzw, sk, tend, u, v, w, wall_flags_0 )
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-             DO  k = nzb+1, nzt
-
-                ibit2 = IBITS(wall_flags_0(k,j,i-1),2,1)
-                ibit1 = IBITS(wall_flags_0(k,j,i-1),1,1)
-                ibit0 = IBITS(wall_flags_0(k,j,i-1),0,1)
-
-                u_comp              = u(k,j,i) - u_gtrans
-                flux_l              = u_comp * (                              &
-                                               ( 37.0_wp * ibit2 * adv_sca_5  &
-                                            +     7.0_wp * ibit1 * adv_sca_3  &
-                                            +              ibit0 * adv_sca_1  &
-                                               ) *                            &
-                                         ( sk(k,j,i)   + sk(k,j,i-1)    )     &
-                                        -      (  8.0_wp * ibit2 * adv_sca_5  &
-                                            +              ibit1 * adv_sca_3  &
-                                               ) *                            &
-                                         ( sk(k,j,i+1) + sk(k,j,i-2)    )     &
-                                        +      (           ibit2 * adv_sca_5  &
-                                               ) *                            &
-                                         ( sk(k,j,i+2) + sk(k,j,i-3)    )     &
-                                               )
-
-                diss_l              = -ABS( u_comp ) * (                      &
-                                               ( 10.0_wp * ibit2 * adv_sca_5  &
-                                            +     3.0_wp * ibit1 * adv_sca_3  &
-                                            +              ibit0 * adv_sca_1  &
-                                               ) *                            &
-                                         ( sk(k,j,i)   - sk(k,j,i-1)    )     &
-                                        -      (  5.0_wp * ibit2 * adv_sca_5  &
-                                            +              ibit1 * adv_sca_3  &
-                                               ) *                            &
-                                         ( sk(k,j,i+1) - sk(k,j,i-2)    )     &
-                                        +      (           ibit2 * adv_sca_5  &
-                                               ) *                            &
-                                         ( sk(k,j,i+2) - sk(k,j,i-3)    )     &
-                                                        )
-
-                ibit2 = IBITS(wall_flags_0(k,j,i),2,1)
-                ibit1 = IBITS(wall_flags_0(k,j,i),1,1)
-                ibit0 = IBITS(wall_flags_0(k,j,i),0,1)
-
-                u_comp    = u(k,j,i+1) - u_gtrans
-                flux_r    = u_comp * (                                        &
-                          ( 37.0_wp * ibit2 * adv_sca_5                       &
-                      +      7.0_wp * ibit1 * adv_sca_3                       &
-                      +               ibit0 * adv_sca_1                       &
-                          ) *                                                 &
-                             ( sk(k,j,i+1) + sk(k,j,i)   )                    &
-                   -      (  8.0_wp * ibit2 * adv_sca_5                       &
-                       +              ibit1 * adv_sca_3                       &
-                          ) *                                                 &
-                             ( sk(k,j,i+2) + sk(k,j,i-1) )                    &
-                   +      (           ibit2 * adv_sca_5                       &
-                          ) *                                                 &
-                             ( sk(k,j,i+3) + sk(k,j,i-2) )                    &
-                                     )
-
-                diss_r    = -ABS( u_comp ) * (                                &
-                          ( 10.0_wp * ibit2 * adv_sca_5                       &
-                       +     3.0_wp * ibit1 * adv_sca_3                       &
-                       +              ibit0 * adv_sca_1                       &
-                          ) *                                                 &
-                             ( sk(k,j,i+1) - sk(k,j,i)   )                    &
-                   -      (  5.0_wp * ibit2 * adv_sca_5                       &
-                       +              ibit1 * adv_sca_3                       &
-                          ) *                                                 &
-                             ( sk(k,j,i+2) - sk(k,j,i-1) )                    &
-                   +      (           ibit2 * adv_sca_5                       &
-                          ) *                                                 &
-                             ( sk(k,j,i+3) - sk(k,j,i-2) )                    &
-                                             )
-
-                ibit5 = IBITS(wall_flags_0(k,j-1,i),5,1)
-                ibit4 = IBITS(wall_flags_0(k,j-1,i),4,1)
-                ibit3 = IBITS(wall_flags_0(k,j-1,i),3,1)
-
-                v_comp    = v(k,j,i) - v_gtrans
-                flux_s    = v_comp * (                                        &
-                          ( 37.0_wp * ibit5 * adv_sca_5                       &
-                       +     7.0_wp * ibit4 * adv_sca_3                       &
-                       +              ibit3 * adv_sca_1                       &
-                          ) *                                                 &
-                             ( sk(k,j,i)  + sk(k,j-1,i)     )                 &
-                    -     (  8.0_wp * ibit5 * adv_sca_5                       &
-                       +              ibit4 * adv_sca_3                       &
-                          ) *                                                 &
-                             ( sk(k,j+1,i) + sk(k,j-2,i)    )                 &
-                   +      (           ibit5 * adv_sca_5                       &
-                          ) *                                                 &
-                             ( sk(k,j+2,i) + sk(k,j-3,i)    )                 &
-                                     )
-
-                diss_s    = -ABS( v_comp ) * (                                &
-                          ( 10.0_wp * ibit5 * adv_sca_5                       &
-                       +     3.0_wp * ibit4 * adv_sca_3                       &
-                       +              ibit3 * adv_sca_1                       &
-                          ) *                                                 &
-                             ( sk(k,j,i)   - sk(k,j-1,i)  )                   &
-                   -      (  5.0_wp * ibit5 * adv_sca_5                       &
-                       +              ibit4 * adv_sca_3                       &
-                          ) *                                                 &
-                             ( sk(k,j+1,i) - sk(k,j-2,i)  )                   &
-                   +      (           ibit5 * adv_sca_5                       &
-                          ) *                                                 &
-                             ( sk(k,j+2,i) - sk(k,j-3,i)  )                   &
-                                             )
-
-                ibit5 = IBITS(wall_flags_0(k,j,i),5,1)
-                ibit4 = IBITS(wall_flags_0(k,j,i),4,1)
-                ibit3 = IBITS(wall_flags_0(k,j,i),3,1)
-
-                v_comp    = v(k,j+1,i) - v_gtrans
-                flux_n    = v_comp * (                                        &
-                          ( 37.0_wp * ibit5 * adv_sca_5                       &
-                       +     7.0_wp * ibit4 * adv_sca_3                       &
-                       +              ibit3 * adv_sca_1                       &
-                          ) *                                                 &
-                             ( sk(k,j+1,i) + sk(k,j,i)   )                    &
-                   -      (  8.0_wp * ibit5 * adv_sca_5                       &
-                       +              ibit4 * adv_sca_3                       &
-                          ) *                                                 &
-                             ( sk(k,j+2,i) + sk(k,j-1,i) )                    &
-                   +      (           ibit5 * adv_sca_5                       &
-                          ) *                                                 &
-                             ( sk(k,j+3,i) + sk(k,j-2,i) )                    &
-                                     )
-
-                diss_n    = -ABS( v_comp ) * (                                &
-                          ( 10.0_wp * ibit5 * adv_sca_5                       &
-                       +     3.0_wp * ibit4 * adv_sca_3                       &
-                       +              ibit3 * adv_sca_1                       &
-                          ) *                                                 &
-                             ( sk(k,j+1,i) - sk(k,j,i)    )                   &
-                   -      (  5.0_wp * ibit5 * adv_sca_5                       &
-                       +              ibit4 * adv_sca_3                       &
-                          ) *                                                 &
-                             ( sk(k,j+2,i) - sk(k,j-1,i)  )                   &
-                   +      (           ibit5 * adv_sca_5                       &
-                          ) *                                                 &
-                             ( sk(k,j+3,i) - sk(k,j-2,i)  )                   &
-                                             )
-
-!
-!--             indizes k_m, k_mm, ... should be known at these point
-                ibit8 = IBITS(wall_flags_0(k-1,j,i),8,1)
-                ibit7 = IBITS(wall_flags_0(k-1,j,i),7,1)
-                ibit6 = IBITS(wall_flags_0(k-1,j,i),6,1)
-
-                k_pp  = k + 2 * ibit8
-                k_mm  = k - 2 * ( ibit7 + ibit8 )
-                k_mmm = k - 3 * ibit8
-
-                flux_d    = w(k-1,j,i) * (                                    &
-                           ( 37.0_wp * ibit8 * adv_sca_5                      &
-                        +     7.0_wp * ibit7 * adv_sca_3                      &
-                        +              ibit6 * adv_sca_1                      &
-                           ) *                                                &
-                                   ( sk(k,j,i)    + sk(k-1,j,i)  )            &
-                    -      (  8.0_wp * ibit8 * adv_sca_5                      &
-                          +            ibit7 * adv_sca_3                      &
-                           ) *                                                &
-                                   ( sk(k+1,j,i) + sk(k_mm,j,i)  )            &
-                    +      (           ibit8 * adv_sca_5                      &
-                           ) *     ( sk(k_pp,j,i)+ sk(k_mmm,j,i) )            &
-                                         )
-
-                diss_d    = -ABS( w(k-1,j,i) ) * (                            &
-                           ( 10.0_wp * ibit8 * adv_sca_5                      &
-                        +     3.0_wp * ibit7 * adv_sca_3                      &
-                        +              ibit6 * adv_sca_1                      &
-                           ) *                                                &
-                                   ( sk(k,j,i)    - sk(k-1,j,i)   )           &
-                    -      (  5.0_wp * ibit8 * adv_sca_5                      &
-                        +              ibit7 * adv_sca_3                      &
-                           ) *                                                &
-                                   ( sk(k+1,j,i)  - sk(k_mm,j,i)  )           &
-                    +      (           ibit8 * adv_sca_5                      &
-                           ) *                                                &
-                                   ( sk(k_pp,j,i) - sk(k_mmm,j,i) )           &
-                                                 )
-
-                ibit8 = IBITS(wall_flags_0(k,j,i),8,1)
-                ibit7 = IBITS(wall_flags_0(k,j,i),7,1)
-                ibit6 = IBITS(wall_flags_0(k,j,i),6,1)
-
-                k_ppp = k + 3 * ibit8
-                k_pp  = k + 2 * ( 1 - ibit6  )
-                k_mm  = k - 2 * ibit8
-
-                flux_t    = w(k,j,i) * (                                      &
-                           ( 37.0_wp * ibit8 * adv_sca_5                      &
-                        +     7.0_wp * ibit7 * adv_sca_3                      &
-                        +              ibit6 * adv_sca_1                      &
-                           ) *                                                &
-                                   ( sk(k+1,j,i)  + sk(k,j,i)    )            &
-                    -      (  8.0_wp * ibit8 * adv_sca_5                      &
-                        +              ibit7 * adv_sca_3                      &
-                           ) *                                                &
-                                   ( sk(k_pp,j,i) + sk(k-1,j,i)  )            &
-                    +      (           ibit8 * adv_sca_5                      &
-                           ) *     ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )            &
-                                       )
-
-                diss_t    = -ABS( w(k,j,i) ) * (                              &
-                           ( 10.0_wp * ibit8 * adv_sca_5                      &
-                        +     3.0_wp * ibit7 * adv_sca_3                      &
-                        +              ibit6 * adv_sca_1                      &
-                           ) *                                                &
-                                   ( sk(k+1,j,i)   - sk(k,j,i)    )           &
-                    -      (  5.0_wp * ibit8 * adv_sca_5                      &
-                        +              ibit7 * adv_sca_3                      &
-                           ) *                                                &
-                                   ( sk(k_pp,j,i)  - sk(k-1,j,i)  )           &
-                    +      (           ibit8 * adv_sca_5                      &
-                           ) *                                                &
-                                   ( sk(k_ppp,j,i) - sk(k_mm,j,i) )           &
-                                         )
-!
-!--             Apply monotonic adjustment.
-                IF ( monotonic_adjustment )  THEN
-!
-!--                At first, calculate first order fluxes.
-                   u_comp = u(k,j,i) - u_gtrans
-                   fl_1   =  ( u_comp   * ( sk(k,j,i) + sk(k,j,i-1) )         &
-                         -ABS( u_comp ) * ( sk(k,j,i) - sk(k,j,i-1) )         &
-                             ) * adv_sca_1 
-
-                   u_comp = u(k,j,i+1) - u_gtrans
-                   fr_1   =  ( u_comp   * ( sk(k,j,i+1) + sk(k,j,i) )         &
-                         -ABS( u_comp ) * ( sk(k,j,i+1) - sk(k,j,i) )         &
-                             ) * adv_sca_1 
-
-                   v_comp = v(k,j,i) - v_gtrans
-                   fs_1   =  ( v_comp   * ( sk(k,j,i) + sk(k,j-1,i) )         &
-                         -ABS( v_comp ) * ( sk(k,j,i) - sk(k,j-1,i) )         &
-                             ) * adv_sca_1 
-
-                   v_comp = v(k,j+1,i) - v_gtrans
-                   fn_1   =  ( v_comp   * ( sk(k,j+1,i) + sk(k,j,i) )         &
-                         -ABS( v_comp ) * ( sk(k,j+1,i) - sk(k,j,i) )         &
-                             ) * adv_sca_1 
-
-                   fd_1   = (  w(k-1,j,i)   * ( sk(k,j,i) + sk(k-1,j,i) )     &
-                        -ABS( w(k-1,j,i) ) * ( sk(k,j,i) - sk(k-1,j,i) )      &
-                            ) * adv_sca_1 
-
-                   ft_1   = (  w(k,j,i)   * ( sk(k+1,j,i) + sk(k,j,i) )       &
-                        -ABS( w(k,j,i) ) * ( sk(k+1,j,i) - sk(k,j,i) )        &
-                            ) * adv_sca_1 
-!
-!--                Calculate ratio of upwind gradients. Note, Min/Max is just
-!--                to avoid if statements.
-                   rl     = ( MAX( 0.0_wp, u(k,j,i) - u_gtrans ) *            & 
-                               ABS( ( sk(k,j,i-1) - sk(k,j,i-2)            ) /&
-                                    ( sk(k,j,i)   - sk(k,j,i-1) + 1E-20_wp )  &
-                                  ) +                                         & 
-                              MIN( 0.0_wp, u(k,j,i) - u_gtrans ) *            &
-                               ABS( ( sk(k,j,i)   - sk(k,j,i+1)            ) /&
-                                    ( sk(k,j,i-1) - sk(k,j,i)   + 1E-20_wp )  &
-                                  )                                           &
-                            ) / ABS( u(k,j,i) - u_gtrans + 1E-20_wp )
-
-                   rr     = ( MAX( 0.0_wp, u(k,j,i+1) - u_gtrans ) *          & 
-                               ABS( ( sk(k,j,i)   - sk(k,j,i-1)            ) /&
-                                    ( sk(k,j,i+1) - sk(k,j,i)   + 1E-20_wp )  &
-                                  ) +                                         & 
-                              MIN( 0.0_wp, u(k,j,i+1) - u_gtrans ) *          &
-                               ABS( ( sk(k,j,i+1) - sk(k,j,i+2)            ) /&
-                                    ( sk(k,j,i)   - sk(k,j,i+1) + 1E-20_wp )  &
-                                  )                                           &
-                            ) / ABS( u(k,j,i+1) - u_gtrans + 1E-20_wp )
-
-                   rs     = ( MAX( 0.0_wp, v(k,j,i) - v_gtrans ) *            & 
-                               ABS( ( sk(k,j-1,i) - sk(k,j-2,i)            ) /&
-                                    ( sk(k,j,i)   - sk(k,j-1,i) + 1E-20_wp )  &
-                                  ) +                                         & 
-                              MIN( 0.0_wp, v(k,j,i) - v_gtrans ) *            &
-                               ABS( ( sk(k,j,i)   - sk(k,j+1,i)            ) /&
-                                    ( sk(k,j-1,i) - sk(k,j,i)   + 1E-20_wp )  &
-                                  )                                           &
-                            ) / ABS( v(k,j,i) - v_gtrans + 1E-20_wp )
-
-                   rn     = ( MAX( 0.0_wp, v(k,j+1,i) - v_gtrans ) *          & 
-                               ABS( ( sk(k,j,i)   - sk(k,j-1,i)            ) /&
-                                    ( sk(k,j+1,i) - sk(k,j,i)   + 1E-20_wp )  &
-                                  ) +                                         & 
-                              MIN( 0.0_wp, v(k,j+1,i) - v_gtrans ) *          &
-                               ABS( ( sk(k,j+1,i) - sk(k,j+2,i)            ) /&
-                                    ( sk(k,j,i)   - sk(k,j+1,i) + 1E-20_wp )  &
-                                  )                                           &
-                            ) / ABS( v(k,j+1,i) - v_gtrans + 1E-20_wp )     
-!   
-!--                Reuse k_mm and compute k_mmm for the vertical gradient ratios. 
-!--                Note, for vertical advection below the third grid point above 
-!--                surface ( or below the model top) rd and rt are set to 0, i.e. 
-!--                use of first order scheme is enforced.
-                   k_mmm  = k - 3 * ibit8
-
-                   rd     = ( MAX( 0.0_wp, w(k-1,j,i) ) *                     & 
-                            ABS( ( sk(k_mm,j,i) - sk(k_mmm,j,i)           ) / &
-                                 ( sk(k-1,j,i)  - sk(k_mm,j,i) + 1E-20_wp )   &
-                               ) +                                            & 
-                              MIN( 0.0_wp, w(k-1,j,i) ) *                     &
-                            ABS( ( sk(k-1,j,i) - sk(k,j,i)            ) /     &
-                                 ( sk(k_mm,j,i) - sk(k-1,j,i)   + 1E-20_wp )  &
-                               )                                              &
-                            ) * ibit8 / ABS( w(k-1,j,i) + 1E-20_wp ) 
- 
-                   rt     = ( MAX( 0.0_wp, w(k,j,i) ) *                       & 
-                            ABS( ( sk(k,j,i)   - sk(k-1,j,i)            ) /   &
-                                 ( sk(k+1,j,i) - sk(k,j,i)   + 1E-20_wp )     &
-                               ) +                                            & 
-                              MIN( 0.0_wp, w(k,j,i) ) *                       &
-                            ABS( ( sk(k+1,j,i) - sk(k_pp,j,i)           ) /   &
-                                 ( sk(k,j,i)   - sk(k+1,j,i) + 1E-20_wp )     &
-                               )                                              &
-                            ) * ibit8 / ABS( w(k,j,i) + 1E-20_wp )
-!
-!--                Calculate empirical limiter function (van Albada2 limiter).
-                   phi_l = MIN( 1.0_wp, ( 2.0_wp * ABS( rl ) ) /              &
-                                        ( rl**2 + 1.0_wp ) ) 
-                   phi_r = MIN( 1.0_wp, ( 2.0_wp * ABS( rr ) ) /              &
-                                        ( rr**2 + 1.0_wp ) ) 
-                   phi_s = MIN( 1.0_wp, ( 2.0_wp * ABS( rs ) ) /              &
-                                        ( rs**2 + 1.0_wp ) ) 
-                   phi_n = MIN( 1.0_wp, ( 2.0_wp * ABS( rn ) ) /              &
-                                        ( rn**2 + 1.0_wp ) ) 
-                   phi_d = MIN( 1.0_wp, ( 2.0_wp * ABS( rd ) ) /              &
-                                        ( rd**2 + 1.0_wp ) ) 
-                   phi_t = MIN( 1.0_wp, ( 2.0_wp * ABS( rt ) ) /              &
-                                        ( rt**2 + 1.0_wp ) ) 
-!
-!--                Calculate the resulting monotone flux. 
-                   flux_l = fl_1 - phi_l * ( fl_1 - flux_l )
-                   flux_r = fr_1 - phi_r * ( fr_1 - flux_r )
-                   flux_s = fs_1 - phi_s * ( fs_1 - flux_s )
-                   flux_n = fn_1 - phi_n * ( fn_1 - flux_n )
-                   flux_d = fd_1 - phi_d * ( fd_1 - flux_d )
-                   flux_t = ft_1 - phi_t * ( ft_1 - flux_t )
-!
-!--                Moreover, modify dissipation flux according to the limiter. 
-                   diss_l = diss_l * phi_l
-                   diss_r = diss_r * phi_r
-                   diss_s = diss_s * phi_s
-                   diss_n = diss_n * phi_n
-                   diss_d = diss_d * phi_d
-                   diss_t = diss_t * phi_t
-
-                ENDIF
-!
-!--             Calculate the divergence of the velocity field. A respective
-!--             correction is needed to overcome numerical instabilities caused
-!--             by a not sufficient reduction of divergences near topography.
-                div   =   ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 )             &
-                          - u(k,j,i)   * ( IBITS(wall_flags_0(k,j,i-1),0,1)    &
-                                         + IBITS(wall_flags_0(k,j,i-1),1,1)    &
-                                         + IBITS(wall_flags_0(k,j,i-1),2,1)    &
-                                         )                                     &
-                          ) * ddx                                              &
-                        + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 )             &
-                          - v(k,j,i)   * ( IBITS(wall_flags_0(k,j-1,i),3,1)    &
-                                         + IBITS(wall_flags_0(k,j-1,i),4,1)    &
-                                         + IBITS(wall_flags_0(k,j-1,i),5,1)    &
-                                         )                                     &
-                          ) * ddy                                              &
-                        + ( w(k,j,i)   * ( ibit6 + ibit7 + ibit8 )             &
-                          - w(k-1,j,i) * ( IBITS(wall_flags_0(k-1,j,i),6,1)    &
-                                         + IBITS(wall_flags_0(k-1,j,i),7,1)    &
-                                         + IBITS(wall_flags_0(k-1,j,i),8,1)    &
-                                         )                                     &      
-                          ) * ddzw(k)
-
-
-                tend(k,j,i) = - (                                             &
-                               ( flux_r + diss_r - flux_l - diss_l ) * ddx    &
-                             + ( flux_n + diss_n - flux_s - diss_s ) * ddy    &
-                             + ( flux_t + diss_t - flux_d - diss_d ) * ddzw(k)&
-                                ) + div * sk(k,j,i)
-
-!++
-!--             Evaluation of statistics
-!                SELECT CASE ( sk_char )
-!
-!                   CASE ( 'pt' )
-!                      sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn)         &
-!                       + ( flux_t + diss_t )                                &
-!                       *   weight_substep(intermediate_timestep_count)
-!                   CASE ( 'sa' )
-!                      sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn)         &
-!                       + ( flux_t + diss_t )                                &
-!                       *   weight_substep(intermediate_timestep_count)
-!                   CASE ( 'q' )
-!                      sums_wsqs_ws_l(k,tn) = sums_wsqs_ws_l(k,tn)           &
-!                      + ( flux_t + diss_t )                                 &
-!                      *   weight_substep(intermediate_timestep_count)
-!                   CASE ( 'qr' )
-!                      sums_wsqrs_ws_l(k,tn) = sums_wsqrs_ws_l(k,tn)         &
-!                      + ( flux_t + diss_t )                                 &
-!                      *   weight_substep(intermediate_timestep_count)
-!                   CASE ( 'nr' )
-!                      sums_wsnrs_ws_l(k,tn) = sums_wsnrs_ws_l(k,tn)         &
-!                      + ( flux_t + diss_t )                                 &
-!                      *   weight_substep(intermediate_timestep_count)
-!
-!                END SELECT
-
-             ENDDO
-         ENDDO
-      ENDDO
-      !$acc end kernels
-
-    END SUBROUTINE advec_s_ws_acc
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Advection of u - Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_u_ws
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE constants,                                                          &
-           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
-
-       USE control_parameters,                                                 &
-           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxlu, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0
-           
-       USE kinds
-       
-       USE statistics,                                                         &
-           ONLY:  hom, sums_us2_ws_l, sums_wsus_ws_l, weight_substep
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  ibit9  !<
-       INTEGER(iwp) ::  ibit10 !<
-       INTEGER(iwp) ::  ibit11 !<
-       INTEGER(iwp) ::  ibit12 !<
-       INTEGER(iwp) ::  ibit13 !<
-       INTEGER(iwp) ::  ibit14 !<
-       INTEGER(iwp) ::  ibit15 !<
-       INTEGER(iwp) ::  ibit16 !<
-       INTEGER(iwp) ::  ibit17 !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  k      !<
-       INTEGER(iwp) ::  k_mm   !<
-       INTEGER(iwp) ::  k_pp   !<
-       INTEGER(iwp) ::  k_ppp  !<
-       INTEGER(iwp) ::  tn = 0 !<
-       
-       REAL(wp)    ::  diss_d !<
-       REAL(wp)    ::  div    !<
-       REAL(wp)    ::  flux_d !<
-       REAL(wp)    ::  gu     !<
-       REAL(wp)    ::  gv     !<
-       REAL(wp)    ::  v_comp !<
-       REAL(wp)    ::  w_comp !<
-       
-       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local_u !<
-       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local_u !<
-       
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_u !<
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local_u !<
-       
-       REAL(wp), DIMENSION(nzb:nzt) ::  diss_n !<
-       REAL(wp), DIMENSION(nzb:nzt) ::  diss_r !<
-       REAL(wp), DIMENSION(nzb:nzt) ::  diss_t !<
-       REAL(wp), DIMENSION(nzb:nzt) ::  flux_n !<
-       REAL(wp), DIMENSION(nzb:nzt) ::  flux_r !<
-       REAL(wp), DIMENSION(nzb:nzt) ::  flux_t !<
-       REAL(wp), DIMENSION(nzb:nzt) ::  u_comp !<
- 
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-
-!
-!--    Compute the fluxes for the whole left boundary of the processor domain.
-       i = nxlu
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzb_max
-
-             ibit11 = IBITS(wall_flags_0(k,j,i-1),11,1)
-             ibit10 = IBITS(wall_flags_0(k,j,i-1),10,1)
-             ibit9  = IBITS(wall_flags_0(k,j,i-1),9,1)
-
-             u_comp(k)                = u(k,j,i) + u(k,j,i-1) - gu
-             swap_flux_x_local_u(k,j) = u_comp(k) * (                          &
-                                       ( 37.0_wp * ibit11 * adv_mom_5             &
-                                    +     7.0_wp * ibit10 * adv_mom_3             &
-                                    +              ibit9  * adv_mom_1             &
-                                       ) *                                     &
-                                     ( u(k,j,i)   + u(k,j,i-1) )               &
-                                -      (  8.0_wp * ibit11 * adv_mom_5             &
-                                    +              ibit10 * adv_mom_3             &
-                                       ) *                                     &
-                                     ( u(k,j,i+1) + u(k,j,i-2) )               &
-                                +      (           ibit11 * adv_mom_5             &
-                                       ) *                                     &
-                                     ( u(k,j,i+2) + u(k,j,i-3) )               &
-                                                   )
-
-              swap_diss_x_local_u(k,j) = - ABS( u_comp(k) ) * (                &
-                                       ( 10.0_wp * ibit11 * adv_mom_5             &
-                                    +     3.0_wp * ibit10 * adv_mom_3             &
-                                    +              ibit9  * adv_mom_1             &
-                                       ) *                                     &
-                                     ( u(k,j,i)   - u(k,j,i-1) )               &
-                                -      (  5.0_wp * ibit11 * adv_mom_5             &
-                                    +              ibit10 * adv_mom_3             &
-                                       ) *                                     &
-                                     ( u(k,j,i+1) - u(k,j,i-2) )               &
-                                +      (           ibit11 * adv_mom_5             &
-                                       ) *                                     &
-                                     ( u(k,j,i+2) - u(k,j,i-3) )               &
-                                                             )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             u_comp(k)         = u(k,j,i) + u(k,j,i-1) - gu
-             swap_flux_x_local_u(k,j) = u_comp(k) * (                          &
-                             37.0_wp * ( u(k,j,i) + u(k,j,i-1)   )                &
-                           -  8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) )                &
-                           +           ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_5
-             swap_diss_x_local_u(k,j) = - ABS(u_comp(k)) * (                   &
-                             10.0_wp * ( u(k,j,i) - u(k,j,i-1)   )                &
-                           -  5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) )                &
-                           +           ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_5
-
-          ENDDO
-       ENDDO
-
-       DO i = nxlu, nxr
-!       
-!--       The following loop computes the fluxes for the south boundary points
-          j = nys
-          DO  k = nzb+1, nzb_max
-
-             ibit14 = IBITS(wall_flags_0(k,j-1,i),14,1)
-             ibit13 = IBITS(wall_flags_0(k,j-1,i),13,1)
-             ibit12 = IBITS(wall_flags_0(k,j-1,i),12,1)
-
-             v_comp                 = v(k,j,i) + v(k,j,i-1) - gv
-             swap_flux_y_local_u(k) = v_comp * (                              &
-                                   ( 37.0_wp * ibit14 * adv_mom_5                &
-                                +     7.0_wp * ibit13 * adv_mom_3                &
-                                +              ibit12 * adv_mom_1                &
-                                   ) *                                        &
-                                     ( u(k,j,i)   + u(k,j-1,i) )              &
-                            -      (  8.0_wp * ibit14 * adv_mom_5                &
-                            +                  ibit13 * adv_mom_3                    &
-                                   ) *                                        &
-                                     ( u(k,j+1,i) + u(k,j-2,i) )              &
-                        +      (               ibit14 * adv_mom_5                    &
-                               ) *                                            &
-                                     ( u(k,j+2,i) + u(k,j-3,i) )              &
-                                               )
-
-             swap_diss_y_local_u(k) = - ABS ( v_comp ) * (                    &
-                                   ( 10.0_wp * ibit14 * adv_mom_5                &
-                                +     3.0_wp * ibit13 * adv_mom_3                &
-                                +              ibit12 * adv_mom_1                &
-                                   ) *                                        &
-                                     ( u(k,j,i)   - u(k,j-1,i) )              &
-                            -      (  5.0_wp * ibit14 * adv_mom_5                &
-                                +              ibit13 * adv_mom_3                &
-                                   ) *                                        &
-                                     ( u(k,j+1,i) - u(k,j-2,i) )              &
-                            +      (           ibit14 * adv_mom_5                &
-                                   ) *                                        &
-                                     ( u(k,j+2,i) - u(k,j-3,i) )              &
-                                                         )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             v_comp                 = v(k,j,i) + v(k,j,i-1) - gv
-             swap_flux_y_local_u(k) = v_comp * (                              &
-                           37.0_wp * ( u(k,j,i) + u(k,j-1,i)   )                 &
-                         -  8.0_wp * ( u(k,j+1,i) + u(k,j-2,i) )                 &
-                         +           ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5
-             swap_diss_y_local_u(k) = - ABS(v_comp) * (                       &
-                           10.0_wp * ( u(k,j,i) - u(k,j-1,i)   )                 &
-                         -  5.0_wp * ( u(k,j+1,i) - u(k,j-2,i) )                 &
-                         +           ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_5
-
-          ENDDO
-!
-!--       Computation of interior fluxes and tendency terms
-          DO  j = nys, nyn
-
-             flux_t(0) = 0.0_wp
-             diss_t(0) = 0.0_wp
-             flux_d    = 0.0_wp
-             diss_d    = 0.0_wp
-
-             DO  k = nzb+1, nzb_max
-
-                ibit11 = IBITS(wall_flags_0(k,j,i),11,1)
-                ibit10 = IBITS(wall_flags_0(k,j,i),10,1)
-                ibit9  = IBITS(wall_flags_0(k,j,i),9,1)
-
-                u_comp(k) = u(k,j,i+1) + u(k,j,i)
-                flux_r(k) = ( u_comp(k) - gu ) * (                           &
-                          ( 37.0_wp * ibit11 * adv_mom_5                        &
-                       +     7.0_wp * ibit10 * adv_mom_3                        &
-                       +              ibit9  * adv_mom_1                        &
-                          ) *                                                &
-                                 ( u(k,j,i+1) + u(k,j,i)   )                 &
-                   -      (  8.0_wp * ibit11 * adv_mom_5                        &
-                       +              ibit10 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( u(k,j,i+2) + u(k,j,i-1) )                 &
-                   +      (           ibit11 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( u(k,j,i+3) + u(k,j,i-2) )                 &
-                                                 )
-
-                diss_r(k) = - ABS( u_comp(k) - gu ) * (                      &
-                          ( 10.0_wp * ibit11 * adv_mom_5                        &
-                       +     3.0_wp * ibit10 * adv_mom_3                        & 
-                       +              ibit9  * adv_mom_1                        &
-                          ) *                                                &
-                                 ( u(k,j,i+1) - u(k,j,i)  )                  &
-                   -      (  5.0_wp * ibit11 * adv_mom_5                        &
-                       +              ibit10 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( u(k,j,i+2) - u(k,j,i-1) )                 &
-                   +      (           ibit11 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( u(k,j,i+3) - u(k,j,i-2) )                 &
-                                                     )
-
-                ibit14 = IBITS(wall_flags_0(k,j,i),14,1)
-                ibit13 = IBITS(wall_flags_0(k,j,i),13,1)
-                ibit12 = IBITS(wall_flags_0(k,j,i),12,1)
-
-                v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
-                flux_n(k) = v_comp * (                                       &
-                          ( 37.0_wp * ibit14 * adv_mom_5                        &
-                       +     7.0_wp * ibit13 * adv_mom_3                        &
-                       +              ibit12 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( u(k,j+1,i) + u(k,j,i)   )                 &
-                   -      (  8.0_wp * ibit14 * adv_mom_5                        &
-                       +              ibit13 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( u(k,j+2,i) + u(k,j-1,i) )                 &
-                   +      (           ibit14 * adv_mom_5                        & 
-                          ) *                                                &
-                                 ( u(k,j+3,i) + u(k,j-2,i) )                 &
-                                                 )
-
-                diss_n(k) = - ABS ( v_comp ) * (                             &
-                          ( 10.0_wp * ibit14 * adv_mom_5                        &
-                       +     3.0_wp * ibit13 * adv_mom_3                        &
-                       +              ibit12 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( u(k,j+1,i) - u(k,j,i)  )                  &
-                   -      (  5.0_wp * ibit14 * adv_mom_5                        &
-                       +              ibit13 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( u(k,j+2,i) - u(k,j-1,i) )                 &
-                   +      (           ibit14 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( u(k,j+3,i) - u(k,j-2,i) )                 &
-                                                      )
-!
-!--             k index has to be modified near bottom and top, else array
-!--             subscripts will be exceeded.
-                ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
-                ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
-                ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
-
-                k_ppp = k + 3 * ibit17
-                k_pp  = k + 2 * ( 1 - ibit15  )
-                k_mm  = k - 2 * ibit17
-
-                w_comp    = w(k,j,i) + w(k,j,i-1)
-                flux_t(k) = w_comp  * (                                      &
-                          ( 37.0_wp * ibit17 * adv_mom_5                        &
-                       +     7.0_wp * ibit16 * adv_mom_3                        &
-                       +              ibit15 * adv_mom_1                        & 
-                          ) *                                                &
-                             ( u(k+1,j,i)  + u(k,j,i)     )                  &
-                   -      (  8.0_wp * ibit17 * adv_mom_5                        &
-                       +              ibit16 * adv_mom_3                        &
-                          ) *                                                &
-                             ( u(k_pp,j,i) + u(k-1,j,i)   )                  &
-                   +      (           ibit17 * adv_mom_5                        &
-                          ) *                                                &
-                             ( u(k_ppp,j,i) + u(k_mm,j,i) )                  &
-                                      )
-
-                diss_t(k) = - ABS( w_comp ) * (                              &
-                          ( 10.0_wp * ibit17 * adv_mom_5                        &
-                       +     3.0_wp * ibit16 * adv_mom_3                        &
-                       +              ibit15 * adv_mom_1                        &
-                          ) *                                                &
-                             ( u(k+1,j,i)   - u(k,j,i)    )                  &
-                   -      (  5.0_wp * ibit17 * adv_mom_5                        &
-                       +              ibit16 * adv_mom_3                        &
-                          ) *                                                &
-                             ( u(k_pp,j,i)  - u(k-1,j,i)  )                  &
-                   +      (           ibit17 * adv_mom_5                        &
-                           ) *                                               &
-                             ( u(k_ppp,j,i) - u(k_mm,j,i) )                  &
-                                              )
-!
-!--             Calculate the divergence of the velocity field. A respective
-!--             correction is needed to overcome numerical instabilities caused
-!--             by a not sufficient reduction of divergences near topography.
-                div = ( ( u_comp(k) * ( ibit9 + ibit10 + ibit11 )             &
-                - ( u(k,j,i)   + u(k,j,i-1)   )                               &
-                                    * ( IBITS(wall_flags_0(k,j,i-1),9,1)      &
-                                      + IBITS(wall_flags_0(k,j,i-1),10,1)     &
-                                      + IBITS(wall_flags_0(k,j,i-1),11,1)     &
-                                      )                                       &   
-                  ) * ddx                                                     &
-               +  ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 )            &
-                  - ( v(k,j,i)   + v(k,j,i-1 )  )                             &
-                                    * ( IBITS(wall_flags_0(k,j-1,i),12,1)     &
-                                      + IBITS(wall_flags_0(k,j-1,i),13,1)     &
-                                      + IBITS(wall_flags_0(k,j-1,i),14,1)     &
-                                      )                                       &
-                  ) * ddy                                                     &
-               +  ( w_comp          * ( ibit15 + ibit16 + ibit17 )            &
-                - ( w(k-1,j,i) + w(k-1,j,i-1) )                               &
-                                    * ( IBITS(wall_flags_0(k-1,j,i),15,1)     &
-                                      + IBITS(wall_flags_0(k-1,j,i),16,1)     &
-                                      + IBITS(wall_flags_0(k-1,j,i),17,1)     &
-                                      )                                       &  
-                  ) * ddzw(k)   &
-                ) * 0.5_wp
-
-
-
-                tend(k,j,i) = tend(k,j,i) - (                                  &
-                 ( flux_r(k) + diss_r(k)                                       &
-               -   swap_flux_x_local_u(k,j) - swap_diss_x_local_u(k,j) ) * ddx &
-               + ( flux_n(k) + diss_n(k)                                       &
-               -   swap_flux_y_local_u(k)   - swap_diss_y_local_u(k)   ) * ddy &
-               + ( flux_t(k) + diss_t(k)                                       &
-               -   flux_d    - diss_d                                          &
-                                                                  ) * ddzw(k)  &
-                                           ) + div * u(k,j,i)
-
-                swap_flux_x_local_u(k,j) = flux_r(k)
-                swap_diss_x_local_u(k,j) = diss_r(k)
-                swap_flux_y_local_u(k)   = flux_n(k)
-                swap_diss_y_local_u(k)   = diss_n(k)
-                flux_d                   = flux_t(k)
-                diss_d                   = diss_t(k)
-!
-!--             Statistical Evaluation of u'u'. The factor has to be applied
-!--             for right evaluation when gallilei_trans = .T. .
-                sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                     &
-                              + ( flux_r(k) *                                 &
-                                ( u_comp(k) - 2.0_wp * hom(k,1,1,0) )            &
-                              / ( u_comp(k) - gu + 1.0E-20_wp    )            &
-                              +   diss_r(k) *                                 &
-                                  ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0) )       &
-                              / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) )      &
-                              *   weight_substep(intermediate_timestep_count)
-!
-!--             Statistical Evaluation of w'u'.
-                sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                   &
-                              + ( flux_t(k) + diss_t(k) )                     &
-                              *   weight_substep(intermediate_timestep_count)
-             ENDDO
-
-             DO  k = nzb_max+1, nzt
-
-                u_comp(k) = u(k,j,i+1) + u(k,j,i)
-                flux_r(k) = ( u_comp(k) - gu ) * (                            &
-                         37.0_wp * ( u(k,j,i+1) + u(k,j,i)   )                   &
-                       -  8.0_wp * ( u(k,j,i+2) + u(k,j,i-1) )                   &
-                       +           ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_5
-                diss_r(k) = - ABS( u_comp(k) - gu ) * (                       &
-                         10.0_wp * ( u(k,j,i+1) - u(k,j,i)   )                   &
-                       -  5.0_wp * ( u(k,j,i+2) - u(k,j,i-1) )                   &
-                       +           ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_5
-
-                v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
-                flux_n(k) = v_comp * (                                        &
-                         37.0_wp * ( u(k,j+1,i) + u(k,j,i)   )                   &
-                       -  8.0_wp * ( u(k,j+2,i) + u(k,j-1,i) )                   &
-                       +           ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_5
-                diss_n(k) = - ABS( v_comp ) * (                               &
-                         10.0_wp * ( u(k,j+1,i) - u(k,j,i)   )                   &
-                       -  5.0_wp * ( u(k,j+2,i) - u(k,j-1,i) )                   &
-                       +           ( u(k,j+3,i) - u(k,j-2,i) ) ) * adv_mom_5
-!
-!--             k index has to be modified near bottom and top, else array
-!--             subscripts will be exceeded.
-                ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
-                ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
-                ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
-
-                k_ppp = k + 3 * ibit17
-                k_pp  = k + 2 * ( 1 - ibit15  )
-                k_mm  = k - 2 * ibit17
-
-                w_comp    = w(k,j,i) + w(k,j,i-1)
-                flux_t(k) = w_comp  * (                                      &
-                          ( 37.0_wp * ibit17 * adv_mom_5                        &
-                       +     7.0_wp * ibit16 * adv_mom_3                        &
-                       +              ibit15 * adv_mom_1                        &
-                          ) *                                                &
-                             ( u(k+1,j,i)  + u(k,j,i)     )                  &
-                   -      (  8.0_wp * ibit17 * adv_mom_5                        &
-                       +              ibit16 * adv_mom_3                        &
-                          ) *                                                &
-                             ( u(k_pp,j,i) + u(k-1,j,i)   )                  &
-                   +      (           ibit17 * adv_mom_5                        &
-                          ) *                                                &
-                             ( u(k_ppp,j,i) + u(k_mm,j,i) )                  &
-                                      )
-
-                diss_t(k) = - ABS( w_comp ) * (                              &
-                          ( 10.0_wp * ibit17 * adv_mom_5                        &
-                       +     3.0_wp * ibit16 * adv_mom_3                        &
-                       +              ibit15 * adv_mom_1                        &
-                          ) *                                                &
-                             ( u(k+1,j,i)   - u(k,j,i)    )                  &
-                   -      (  5.0_wp * ibit17 * adv_mom_5                        &
-                       +              ibit16 * adv_mom_3                        &
-                          ) *                                                &
-                             ( u(k_pp,j,i)  - u(k-1,j,i)  )                  &
-                   +      (           ibit17 * adv_mom_5                        &
-                           ) *                                               &
-                             ( u(k_ppp,j,i) - u(k_mm,j,i) )                  &
-                                              )
-!
-!--             Calculate the divergence of the velocity field. A respective
-!--             correction is needed to overcome numerical instabilities caused
-!--             by a not sufficient reduction of divergences near topography.
-                div = ( ( u_comp(k)   - ( u(k,j,i)   + u(k,j,i-1)   ) ) * ddx &
-                     +  ( v_comp + gv - ( v(k,j,i)   + v(k,j,i-1 )  ) ) * ddy &
-                     +  ( w_comp      - ( w(k-1,j,i) + w(k-1,j,i-1) ) )       &
-                                                                    * ddzw(k) &
-                      ) * 0.5_wp
-
-                 tend(k,j,i) = tend(k,j,i) - (                                 &
-                 ( flux_r(k) + diss_r(k)                                       &
-               -   swap_flux_x_local_u(k,j) - swap_diss_x_local_u(k,j) ) * ddx &
-               + ( flux_n(k) + diss_n(k)                                       &
-               -   swap_flux_y_local_u(k)   - swap_diss_y_local_u(k)   ) * ddy &
-               + ( flux_t(k) + diss_t(k)                                       &
-               -   flux_d    - diss_d                                          &
-                                                                  ) * ddzw(k)  &
-                                           ) + div * u(k,j,i)
-
-                 swap_flux_x_local_u(k,j) = flux_r(k)
-                 swap_diss_x_local_u(k,j) = diss_r(k)
-                 swap_flux_y_local_u(k)   = flux_n(k)
-                 swap_diss_y_local_u(k)   = diss_n(k)
-                 flux_d                   = flux_t(k)
-                 diss_d                   = diss_t(k)
-!
-!--              Statistical Evaluation of u'u'. The factor has to be applied
-!--              for right evaluation when gallilei_trans = .T. .
-                 sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                    &
-                              + ( flux_r(k) *                                 &
-                                ( u_comp(k) - 2.0_wp * hom(k,1,1,0) )            &
-                              / ( u_comp(k) - gu + 1.0E-20_wp   )             &
-                              +   diss_r(k) *                                 &
-                                  ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0) )       &
-                              / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) )      &
-                              *   weight_substep(intermediate_timestep_count)
-!
-!--              Statistical Evaluation of w'u'.
-                 sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                  &
-                              + ( flux_t(k) + diss_t(k) )                     &
-                              *   weight_substep(intermediate_timestep_count)
-       ENDDO
-          ENDDO
-       ENDDO
-       sums_us2_ws_l(nzb,tn) = sums_us2_ws_l(nzb+1,tn)
-
-
-    END SUBROUTINE advec_u_ws
-    
-    
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Advection of u - Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_u_ws_acc
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE constants,                                                          &
-           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
-
-       USE control_parameters,                                                 &
-           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
-                  nzb_max, nzt, wall_flags_0
-           
-       USE kinds
-       
-!        USE statistics,                                                       &
-!            ONLY:  hom, sums_us2_ws_l, sums_wsus_ws_l, weight_substep
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  ibit9  !<
-       INTEGER(iwp) ::  ibit10 !<
-       INTEGER(iwp) ::  ibit11 !<
-       INTEGER(iwp) ::  ibit12 !<
-       INTEGER(iwp) ::  ibit13 !<
-       INTEGER(iwp) ::  ibit14 !<
-       INTEGER(iwp) ::  ibit15 !<
-       INTEGER(iwp) ::  ibit16 !<
-       INTEGER(iwp) ::  ibit17 !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  k      !<
-       INTEGER(iwp) ::  k_mmm  !<
-       INTEGER(iwp) ::  k_mm   !<
-       INTEGER(iwp) ::  k_pp   !<
-       INTEGER(iwp) ::  k_ppp  !<
-       INTEGER(iwp) ::  tn = 0 !<
-
-       REAL(wp)    ::  diss_d   !<
-       REAL(wp)    ::  diss_l   !<
-       REAL(wp)    ::  diss_n   !<
-       REAL(wp)    ::  diss_r   !<
-       REAL(wp)    ::  diss_s   !<
-       REAL(wp)    ::  diss_t   !<
-       REAL(wp)    ::  div      !<
-       REAL(wp)    ::  flux_d   !<
-       REAL(wp)    ::  flux_l   !<
-       REAL(wp)    ::  flux_n   !<
-       REAL(wp)    ::  flux_r   !<
-       REAL(wp)    ::  flux_s   !<
-       REAL(wp)    ::  flux_t   !<
-       REAL(wp)    ::  gu       !<
-       REAL(wp)    ::  gv       !<
-       REAL(wp)    ::  u_comp   !<
-       REAL(wp)    ::  u_comp_l !<
-       REAL(wp)    ::  v_comp   !<
-       REAL(wp)    ::  v_comp_s !<
-       REAL(wp)    ::  w_comp   !<
-
-
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-
-!
-!--    Computation of fluxes and tendency terms
-       !$acc  kernels present( ddzw, tend, u, v, w, wall_flags_0 )
-       DO i = i_left, i_right
-          DO  j = j_south, j_north
-             DO  k = nzb+1, nzt
-
-                ibit11 = IBITS(wall_flags_0(k,j,i-1),11,1)
-                ibit10 = IBITS(wall_flags_0(k,j,i-1),10,1)
-                ibit9  = IBITS(wall_flags_0(k,j,i-1),9,1)
-
-                u_comp_l           = u(k,j,i) + u(k,j,i-1) - gu
-                flux_l             = u_comp_l * (                          &
-                                    ( 37.0_wp * ibit11 * adv_mom_5             &
-                                 +     7.0_wp * ibit10 * adv_mom_3             &
-                                 +              ibit9  * adv_mom_1             &
-                                    ) *                                     &
-                                  ( u(k,j,i)   + u(k,j,i-1) )               &
-                             -      (  8.0_wp * ibit11 * adv_mom_5             &
-                                 +              ibit10 * adv_mom_3             &
-                                    ) *                                     &
-                                  ( u(k,j,i+1) + u(k,j,i-2) )               &
-                             +      (           ibit11 * adv_mom_5             &
-                                    ) *                                     &
-                                  ( u(k,j,i+2) + u(k,j,i-3) )               &
-                                                )
-
-                diss_l             = - ABS( u_comp_l ) * (                &
-                                   ( 10.0_wp * ibit11 * adv_mom_5             &
-                                +     3.0_wp * ibit10 * adv_mom_3             &
-                                +              ibit9  * adv_mom_1             &
-                                   ) *                                     &
-                                 ( u(k,j,i)   - u(k,j,i-1) )               &
-                            -      (  5.0_wp * ibit11 * adv_mom_5             &
-                                +              ibit10 * adv_mom_3             &
-                                   ) *                                     &
-                                 ( u(k,j,i+1) - u(k,j,i-2) )               &
-                            +      (           ibit11 * adv_mom_5             &
-                                   ) *                                     &
-                                 ( u(k,j,i+2) - u(k,j,i-3) )               &
-                                                         )
-
-                ibit11 = IBITS(wall_flags_0(k,j,i),11,1)
-                ibit10 = IBITS(wall_flags_0(k,j,i),10,1)
-                ibit9  = IBITS(wall_flags_0(k,j,i),9,1)
-
-                u_comp    = u(k,j,i+1) + u(k,j,i)
-                flux_r    = ( u_comp   - gu ) * (                           &
-                          ( 37.0_wp * ibit11 * adv_mom_5                        &
-                       +     7.0_wp * ibit10 * adv_mom_3                        &
-                       +              ibit9  * adv_mom_1                        &
-                          ) *                                                &
-                                 ( u(k,j,i+1) + u(k,j,i)   )                 &
-                   -      (  8.0_wp * ibit11 * adv_mom_5                        &
-                       +              ibit10 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( u(k,j,i+2) + u(k,j,i-1) )                 &
-                   +      (           ibit11 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( u(k,j,i+3) + u(k,j,i-2) )                 &
-                                                 )
-
-                diss_r    = - ABS( u_comp    - gu ) * (                      &
-                          ( 10.0_wp * ibit11 * adv_mom_5                        &
-                       +     3.0_wp * ibit10 * adv_mom_3                        &
-                       +              ibit9  * adv_mom_1                        &
-                          ) *                                                &
-                                 ( u(k,j,i+1) - u(k,j,i)  )                  &
-                   -      (  5.0_wp * ibit11 * adv_mom_5                        &
-                       +              ibit10 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( u(k,j,i+2) - u(k,j,i-1) )                 &
-                   +      (           ibit11 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( u(k,j,i+3) - u(k,j,i-2) )                 &
-                                                     )
-
-                ibit14 = IBITS(wall_flags_0(k,j-1,i),14,1)
-                ibit13 = IBITS(wall_flags_0(k,j-1,i),13,1)
-                ibit12 = IBITS(wall_flags_0(k,j-1,i),12,1)
-
-                v_comp_s                 = v(k,j,i) + v(k,j,i-1) - gv
-                flux_s                   = v_comp_s * (                       &
-                                   ( 37.0_wp * ibit14 * adv_mom_5                &
-                                +     7.0_wp * ibit13 * adv_mom_3                &
-                                +              ibit12 * adv_mom_1                &
-                                   ) *                                         &
-                                     ( u(k,j,i)   + u(k,j-1,i) )              &
-                            -      (  8.0_wp * ibit14 * adv_mom_5                &
-                            +                  ibit13 * adv_mom_3                    &
-                                   ) *                                        &
-                                     ( u(k,j+1,i) + u(k,j-2,i) )              &
-                        +      (               ibit14 * adv_mom_5                    &
-                               ) *                                            &
-                                     ( u(k,j+2,i) + u(k,j-3,i) )              &
-                                               )
-
-                diss_s                  = - ABS ( v_comp_s ) * (              &
-                                   ( 10.0_wp * ibit14 * adv_mom_5                &
-                                +     3.0_wp * ibit13 * adv_mom_3                &
-                                +              ibit12 * adv_mom_1                &
-                                   ) *                                        &
-                                     ( u(k,j,i)   - u(k,j-1,i) )              &
-                            -      (  5.0_wp * ibit14 * adv_mom_5                &
-                                +              ibit13 * adv_mom_3                &
-                                   ) *                                        &
-                                     ( u(k,j+1,i) - u(k,j-2,i) )              &
-                            +      (           ibit14 * adv_mom_5                &
-                                   ) *                                        &
-                                     ( u(k,j+2,i) - u(k,j-3,i) )              &
-                                                         )
-
-
-                ibit14 = IBITS(wall_flags_0(k,j,i),14,1)
-                ibit13 = IBITS(wall_flags_0(k,j,i),13,1)
-                ibit12 = IBITS(wall_flags_0(k,j,i),12,1)
-
-                v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
-                flux_n    = v_comp * (                                       &
-                          ( 37.0_wp * ibit14 * adv_mom_5                        &
-                       +     7.0_wp * ibit13 * adv_mom_3                        &
-                       +              ibit12 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( u(k,j+1,i) + u(k,j,i)   )                 &
-                   -      (  8.0_wp * ibit14 * adv_mom_5                        &
-                       +              ibit13 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( u(k,j+2,i) + u(k,j-1,i) )                 &
-                   +      (           ibit14 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( u(k,j+3,i) + u(k,j-2,i) )                 &
-                                                 )
-
-                diss_n    = - ABS ( v_comp ) * (                             &
-                          ( 10.0_wp * ibit14 * adv_mom_5                        &
-                       +     3.0_wp * ibit13 * adv_mom_3                        &
-                       +              ibit12 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( u(k,j+1,i) - u(k,j,i)  )                  &
-                   -      (  5.0_wp * ibit14 * adv_mom_5                        &
-                       +              ibit13 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( u(k,j+2,i) - u(k,j-1,i) )                 &
-                   +      (           ibit14 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( u(k,j+3,i) - u(k,j-2,i) )                 &
-                                                      )
-
-                ibit17 = IBITS(wall_flags_0(k-1,j,i),17,1)
-                ibit16 = IBITS(wall_flags_0(k-1,j,i),16,1)
-                ibit15 = IBITS(wall_flags_0(k-1,j,i),15,1)
-
-                k_pp  = k + 2 * ibit17
-                k_mm  = k - 2 * ( ibit16 + ibit17 )
-                k_mmm = k - 3 * ibit17
-
-                w_comp    = w(k-1,j,i) + w(k-1,j,i-1)
-                flux_d    = w_comp  * (                                      &
-                          ( 37.0_wp * ibit17 * adv_mom_5                        &
-                       +     7.0_wp * ibit16 * adv_mom_3                        &
-                       +              ibit15 * adv_mom_1                        &
-                          ) *                                                &
-                             ( u(k,j,i)    + u(k-1,j,i)   )                  &
-                   -      (  8.0_wp * ibit17 * adv_mom_5                        &
-                       +              ibit16 * adv_mom_3                        &
-                          ) *                                                &
-                             ( u(k+1,j,i) + u(k_mm,j,i)   )                  &
-                   +      (           ibit17 * adv_mom_5                        &
-                          ) *                                                 &
-                             ( u(k_pp,j,i) + u(k_mmm,j,i) )                  &
-                                      )
-
-                diss_d    = - ABS( w_comp ) * (                              &
-                          ( 10.0_wp * ibit17 * adv_mom_5                        &
-                       +     3.0_wp * ibit16 * adv_mom_3                        &
-                       +              ibit15 * adv_mom_1                        &
-                          ) *                                                &
-                             ( u(k,j,i)     - u(k-1,j,i)  )                  &
-                   -      (  5.0_wp * ibit17 * adv_mom_5                        &
-                       +              ibit16 * adv_mom_3                        &
-                          ) *                                                &
-                             ( u(k+1,j,i)  - u(k_mm,j,i)  )                  &
-                   +      (           ibit17 * adv_mom_5                        &
-                           ) *                                               &
-                             ( u(k_pp,j,i) - u(k_mmm,j,i) )                  &
-                                              )
-!
-!--             k index has to be modified near bottom and top, else array
-!--             subscripts will be exceeded.
-                ibit17 = IBITS(wall_flags_0(k,j,i),17,1)
-                ibit16 = IBITS(wall_flags_0(k,j,i),16,1)
-                ibit15 = IBITS(wall_flags_0(k,j,i),15,1)
-
-                k_ppp = k + 3 * ibit17
-                k_pp  = k + 2 * ( 1 - ibit15  )
-                k_mm  = k - 2 * ibit17
-
-                w_comp    = w(k,j,i) + w(k,j,i-1)
-                flux_t    = w_comp  * (                                      &
-                          ( 37.0_wp * ibit17 * adv_mom_5                        &
-                       +     7.0_wp * ibit16 * adv_mom_3                        &
-                       +              ibit15 * adv_mom_1                        &
-                          ) *                                                &
-                             ( u(k+1,j,i)  + u(k,j,i)     )                  &
-                   -      (  8.0_wp * ibit17 * adv_mom_5                        &
-                       +              ibit16 * adv_mom_3                        &
-                          ) *                                                &
-                             ( u(k_pp,j,i) + u(k-1,j,i)   )                  &
-                   +      (           ibit17 * adv_mom_5                        &
-                          ) *                                                &
-                             ( u(k_ppp,j,i) + u(k_mm,j,i) )                  &
-                                      )
-
-                diss_t    = - ABS( w_comp ) * (                              &
-                          ( 10.0_wp * ibit17 * adv_mom_5                        &
-                       +     3.0_wp * ibit16 * adv_mom_3                        &
-                       +              ibit15 * adv_mom_1                        &
-                          ) *                                                &
-                             ( u(k+1,j,i)   - u(k,j,i)    )                  &
-                   -      (  5.0_wp * ibit17 * adv_mom_5                        &
-                       +              ibit16 * adv_mom_3                        &
-                          ) *                                                &
-                             ( u(k_pp,j,i)  - u(k-1,j,i)  )                  &
-                   +      (           ibit17 * adv_mom_5                        &
-                           ) *                                               &
-                             ( u(k_ppp,j,i) - u(k_mm,j,i) )                  &
-                                              )
-!
-!--             Calculate the divergence of the velocity field. A respective
-!--             correction is needed to overcome numerical instabilities caused
-!--             by a not sufficient reduction of divergences near topography.
-                div = ( ( u_comp    * ( ibit9 + ibit10 + ibit11 )             &
-                - ( u(k,j,i)   + u(k,j,i-1)   )                               &
-                                    * ( IBITS(wall_flags_0(k,j,i-1),9,1)      &
-                                      + IBITS(wall_flags_0(k,j,i-1),10,1)     &
-                                      + IBITS(wall_flags_0(k,j,i-1),11,1)     &
-                                      )                                       &   
-                  ) * ddx                                                     &
-               +  ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 )            &
-                  - ( v(k,j,i)   + v(k,j,i-1 )  )                             &
-                                    * ( IBITS(wall_flags_0(k,j-1,i),12,1)     &
-                                      + IBITS(wall_flags_0(k,j-1,i),13,1)     &
-                                      + IBITS(wall_flags_0(k,j-1,i),14,1)     &
-                                      )                                       &
-                  ) * ddy                                                     &
-               +  ( w_comp          * ( ibit15 + ibit16 + ibit17 )            &
-                - ( w(k-1,j,i) + w(k-1,j,i-1) )                               &
-                                    * ( IBITS(wall_flags_0(k-1,j,i),15,1)     &
-                                      + IBITS(wall_flags_0(k-1,j,i),16,1)     &
-                                      + IBITS(wall_flags_0(k-1,j,i),17,1)     &
-                                      )                                       &  
-                  ) * ddzw(k)   &
-                ) * 0.5_wp
-
-
-                tend(k,j,i) = - (                                              &
-                               ( flux_r + diss_r - flux_l - diss_l ) * ddx     &
-                             + ( flux_n + diss_n - flux_s - diss_s ) * ddy     &
-                             + ( flux_t + diss_t - flux_d - diss_d ) * ddzw(k) &
-                                ) + div * u(k,j,i)
-
-!++
-!--             Statistical Evaluation of u'u'. The factor has to be applied
-!--             for right evaluation when gallilei_trans = .T. .
-!                sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn)                     &
-!                              + ( flux_r    *                                 &
-!                                ( u_comp    - 2.0_wp * hom(k,1,1,0) )            &
-!                              / ( u_comp    - gu + 1.0E-20_wp   )             &
-!                              +   diss_r    *                                 &
-!                                  ABS( u_comp    - 2.0_wp * hom(k,1,1,0) )       &
-!                              / ( ABS( u_comp    - gu ) + 1.0E-20_wp ) )      &
-!                              *   weight_substep(intermediate_timestep_count)
-!
-!--             Statistical Evaluation of w'u'.
-!                sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                   &
-!                              + ( flux_t    + diss_t    )                     &
-!                              *   weight_substep(intermediate_timestep_count)
-             ENDDO
-          ENDDO
-       ENDDO
-       !$acc end kernels
-
-!++
-!       sums_us2_ws_l(nzb,tn) = sums_us2_ws_l(nzb+1,tn)
-
-    END SUBROUTINE advec_u_ws_acc
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Advection of v - Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_v_ws
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE constants,                                                          &
-           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
-
-       USE control_parameters,                                                 &
-           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, wall_flags_0
-
-       USE kinds
-
-       USE statistics,                                                         &
-           ONLY:  hom, sums_vs2_ws_l, sums_wsvs_ws_l, weight_substep
-
-       IMPLICIT NONE
-
-
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  ibit18 !<
-       INTEGER(iwp) ::  ibit19 !<
-       INTEGER(iwp) ::  ibit20 !<
-       INTEGER(iwp) ::  ibit21 !<
-       INTEGER(iwp) ::  ibit22 !<
-       INTEGER(iwp) ::  ibit23 !<
-       INTEGER(iwp) ::  ibit24 !<
-       INTEGER(iwp) ::  ibit25 !<
-       INTEGER(iwp) ::  ibit26 !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  k      !<
-       INTEGER(iwp) ::  k_mm   !<
-       INTEGER(iwp) ::  k_pp   !<
-       INTEGER(iwp) ::  k_ppp  !<
-       INTEGER(iwp) ::  tn = 0 !<
-       
-       REAL(wp)    ::  diss_d !<
-       REAL(wp)    ::  div    !<
-       REAL(wp)    ::  flux_d !<
-       REAL(wp)    ::  gu     !<
-       REAL(wp)    ::  gv     !<
-       REAL(wp)    ::  u_comp !<
-       REAL(wp)    ::  w_comp !<
-       
-       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local_v !<
-       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local_v !<
-       
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_v !<
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local_v !<
-       
-       REAL(wp), DIMENSION(nzb:nzt) ::  diss_n !<
-       REAL(wp), DIMENSION(nzb:nzt) ::  diss_r !<
-       REAL(wp), DIMENSION(nzb:nzt) ::  diss_t !<
-       REAL(wp), DIMENSION(nzb:nzt) ::  flux_n !<
-       REAL(wp), DIMENSION(nzb:nzt) ::  flux_r !<
-       REAL(wp), DIMENSION(nzb:nzt) ::  flux_t !<
-       REAL(wp), DIMENSION(nzb:nzt) ::  v_comp !<
-
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-!
-!--    First compute the whole left boundary of the processor domain
-       i = nxl
-       DO  j = nysv, nyn
-          DO  k = nzb+1, nzb_max
-
-             ibit20 = IBITS(wall_flags_0(k,j,i-1),20,1)
-             ibit19 = IBITS(wall_flags_0(k,j,i-1),19,1)
-             ibit18 = IBITS(wall_flags_0(k,j,i-1),18,1)
-
-             u_comp                   = u(k,j-1,i) + u(k,j,i) - gu
-             swap_flux_x_local_v(k,j) = u_comp * (                             &
-                                      ( 37.0_wp * ibit20 * adv_mom_5              &
-                                   +     7.0_wp * ibit19 * adv_mom_3              &
-                                   +              ibit18 * adv_mom_1              &
-                                      ) *                                      &
-                                     ( v(k,j,i)   + v(k,j,i-1) )               &
-                               -      (  8.0_wp * ibit20 * adv_mom_5              &
-                                   +              ibit19 * adv_mom_3              &
-                                      ) *                                      &
-                                     ( v(k,j,i+1) + v(k,j,i-2) )               &
-                               +      (           ibit20 * adv_mom_5              &
-                                      ) *                                      &
-                                     ( v(k,j,i+2) + v(k,j,i-3) )               &
-                                                 )
-
-              swap_diss_x_local_v(k,j) = - ABS( u_comp ) * (                   &
-                                      ( 10.0_wp * ibit20 * adv_mom_5              &
-                                   +     3.0_wp * ibit19 * adv_mom_3              &
-                                   +              ibit18 * adv_mom_1              &
-                                      ) *                                      &
-                                     ( v(k,j,i)   - v(k,j,i-1) )               &
-                               -      (  5.0_wp * ibit20 * adv_mom_5              &
-                                   +              ibit19 * adv_mom_3              &
-                                      ) *                                      &
-                                     ( v(k,j,i+1) - v(k,j,i-2) )               &
-                               +      (           ibit20 * adv_mom_5              &
-                                      ) *                                      &
-                                     ( v(k,j,i+2) - v(k,j,i-3) )               &
-                                                           )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             u_comp                   = u(k,j-1,i) + u(k,j,i) - gu
-             swap_flux_x_local_v(k,j) = u_comp * (                            &
-                             37.0_wp * ( v(k,j,i) + v(k,j,i-1)   )               &
-                           -  8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) )               &
-                           +           ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5
-             swap_diss_x_local_v(k,j) = - ABS( u_comp ) * (                   &
-                             10.0_wp * ( v(k,j,i) - v(k,j,i-1)   )               &
-                           -  5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) )               &
-                           +           ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5
-
-          ENDDO
-
-       ENDDO
-
-       DO i = nxl, nxr
-
-          j = nysv
-          DO  k = nzb+1, nzb_max
-
-             ibit23 = IBITS(wall_flags_0(k,j-1,i),23,1)
-             ibit22 = IBITS(wall_flags_0(k,j-1,i),22,1)
-             ibit21 = IBITS(wall_flags_0(k,j-1,i),21,1)
-
-             v_comp(k)              = v(k,j,i) + v(k,j-1,i) - gv
-             swap_flux_y_local_v(k) = v_comp(k) * (                           &
-                                   ( 37.0_wp * ibit23 * adv_mom_5                &
-                                +     7.0_wp * ibit22 * adv_mom_3                &
-                                +              ibit21 * adv_mom_1                &
-                                   ) *                                        &
-                                     ( v(k,j,i)   + v(k,j-1,i) )              &
-                            -      (  8.0_wp * ibit23 * adv_mom_5                &
-                                +              ibit22 * adv_mom_3                &
-                                   ) *                                        &
-                                     ( v(k,j+1,i) + v(k,j-2,i) )              &
-                            +      (           ibit23 * adv_mom_5                &
-                                   ) *                                        &
-                                     ( v(k,j+2,i) + v(k,j-3,i) )              &
-                                                 )
-
-             swap_diss_y_local_v(k) = - ABS( v_comp(k) ) * (                  &
-                                   ( 10.0_wp * ibit23 * adv_mom_5                &
-                                +     3.0_wp * ibit22 * adv_mom_3                &
-                                +              ibit21 * adv_mom_1                &
-                                   ) *                                        &
-                                     ( v(k,j,i)   - v(k,j-1,i) )              &
-                            -      (  5.0_wp * ibit23 * adv_mom_5                &
-                                +              ibit22 * adv_mom_3                &
-                                   ) *                                        &
-                                     ( v(k,j+1,i) - v(k,j-2,i) )              &
-                            +      (           ibit23 * adv_mom_5                &
-                                   ) *                                        &
-                                     ( v(k,j+2,i) - v(k,j-3,i) )              &
-                                                          )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             v_comp(k)              = v(k,j,i) + v(k,j-1,i) - gv
-             swap_flux_y_local_v(k) = v_comp(k) * (                           &
-                           37.0_wp * ( v(k,j,i) + v(k,j-1,i)   )                 &
-                         -  8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) )                 &
-                         +           ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5
-             swap_diss_y_local_v(k) = - ABS( v_comp(k) ) * (                  &
-                           10.0_wp * ( v(k,j,i) - v(k,j-1,i)   )                 &
-                         -  5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) )                 &
-                         +           ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5
-
-          ENDDO
-
-          DO  j = nysv, nyn
-
-             flux_t(0) = 0.0_wp
-             diss_t(0) = 0.0_wp
-             flux_d    = 0.0_wp
-             diss_d    = 0.0_wp
-
-             DO  k = nzb+1, nzb_max
-
-                ibit20 = IBITS(wall_flags_0(k,j,i),20,1)
-                ibit19 = IBITS(wall_flags_0(k,j,i),19,1)
-                ibit18 = IBITS(wall_flags_0(k,j,i),18,1)
-
-                u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
-                flux_r(k) = u_comp * (                                       &
-                          ( 37.0_wp * ibit20 * adv_mom_5                        &
-                       +     7.0_wp * ibit19 * adv_mom_3                        &
-                       +              ibit18 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( v(k,j,i+1) + v(k,j,i)   )                 &
-                   -      (  8.0_wp * ibit20 * adv_mom_5                        &
-                       +              ibit19 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( v(k,j,i+2) + v(k,j,i-1) )                 &
-                   +      (           ibit20 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( v(k,j,i+3) + v(k,j,i-2) )                 &
-                                     )
-
-                diss_r(k) = - ABS( u_comp ) * (                              &
-                          ( 10.0_wp * ibit20 * adv_mom_5                        &
-                       +     3.0_wp * ibit19 * adv_mom_3                        &
-                       +              ibit18 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( v(k,j,i+1) - v(k,j,i)  )                  &
-                   -      (  5.0_wp * ibit20 * adv_mom_5                        &
-                       +              ibit19 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( v(k,j,i+2) - v(k,j,i-1) )                 &
-                   +      (           ibit20 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( v(k,j,i+3) - v(k,j,i-2) )                 &
-                                              )
-
-                ibit23 = IBITS(wall_flags_0(k,j,i),23,1)
-                ibit22 = IBITS(wall_flags_0(k,j,i),22,1)
-                ibit21 = IBITS(wall_flags_0(k,j,i),21,1)
-
-                v_comp(k) = v(k,j+1,i) + v(k,j,i)
-                flux_n(k) = ( v_comp(k) - gv ) * (                           &
-                          ( 37.0_wp * ibit23 * adv_mom_5                        &
-                       +     7.0_wp * ibit22 * adv_mom_3                        &
-                       +              ibit21 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( v(k,j+1,i) + v(k,j,i)   )                 &
-                   -      (  8.0_wp * ibit23 * adv_mom_5                        &
-                       +              ibit22 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( v(k,j+2,i) + v(k,j-1,i) )                 &
-                   +      (           ibit23 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( v(k,j+3,i) + v(k,j-2,i) )                 &
-                                     )
-
-                diss_n(k) = - ABS( v_comp(k) - gv ) * (                      &
-                          ( 10.0_wp * ibit23 * adv_mom_5                        &
-                       +     3.0_wp * ibit22 * adv_mom_3                        &
-                       +              ibit21 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( v(k,j+1,i) - v(k,j,i)  )                  &
-                   -      (  5.0_wp * ibit23 * adv_mom_5                        &
-                       +              ibit22 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( v(k,j+2,i) - v(k,j-1,i) )                 &
-                   +      (           ibit23 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( v(k,j+3,i) - v(k,j-2,i) )                 &
-                                                      )
-!
-!--             k index has to be modified near bottom and top, else array
-!--             subscripts will be exceeded.
-                ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
-                ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
-                ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
-
-                k_ppp = k + 3 * ibit26
-                k_pp  = k + 2 * ( 1 - ibit24  )
-                k_mm  = k - 2 * ibit26
-
-                w_comp    = w(k,j-1,i) + w(k,j,i)
-                flux_t(k) = w_comp  * (                                      &
-                          ( 37.0_wp * ibit26 * adv_mom_5                        &
-                       +     7.0_wp * ibit25 * adv_mom_3                        &
-                       +              ibit24 * adv_mom_1                        &
-                          ) *                                                &
-                             ( v(k+1,j,i)   + v(k,j,i)    )                  &
-                   -      (  8.0_wp * ibit26 * adv_mom_5                        &
-                       +              ibit25 * adv_mom_3                        &
-                          ) *                                                &
-                             ( v(k_pp,j,i)  + v(k-1,j,i)  )                  &
-                   +      (           ibit26 * adv_mom_5                        &
-                          ) *                                                &
-                             ( v(k_ppp,j,i) + v(k_mm,j,i) )                  &
-                                      )
-
-                diss_t(k) = - ABS( w_comp ) * (                              &
-                          ( 10.0_wp * ibit26 * adv_mom_5                        &
-                       +     3.0_wp * ibit25 * adv_mom_3                        &
-                       +              ibit24 * adv_mom_1                        &
-                          ) *                                                &
-                             ( v(k+1,j,i)   - v(k,j,i)    )                  &
-                   -      (  5.0_wp * ibit26 * adv_mom_5                        &
-                       +              ibit25 * adv_mom_3                        &
-                          ) *                                                &
-                             ( v(k_pp,j,i)  - v(k-1,j,i)  )                  &
-                   +      (           ibit26 * adv_mom_5                        &
-                          ) *                                                &
-                             ( v(k_ppp,j,i) - v(k_mm,j,i) )                  &
-                                               )
-!
-!--             Calculate the divergence of the velocity field. A respective
-!--             correction is needed to overcome numerical instabilities caused
-!--             by a not sufficient reduction of divergences near topography.
-                div = ( ( ( u_comp     + gu )                                 &
-                                       * ( ibit18 + ibit19 + ibit20 )         &
-                - ( u(k,j-1,i)   + u(k,j,i) )                                 &
-                                       * ( IBITS(wall_flags_0(k,j,i-1),18,1)  &
-                                         + IBITS(wall_flags_0(k,j,i-1),19,1)  &
-                                         + IBITS(wall_flags_0(k,j,i-1),20,1)  &
-                                         )                                    &   
-                  ) * ddx                                                     &
-               +  ( v_comp(k)                                                 &
-                                       * ( ibit21 + ibit22 + ibit23 )         &
-                - ( v(k,j,i)     + v(k,j-1,i) )                               &
-                                       * ( IBITS(wall_flags_0(k,j-1,i),21,1)  &
-                                         + IBITS(wall_flags_0(k,j-1,i),22,1)  &
-                                         + IBITS(wall_flags_0(k,j-1,i),23,1)  &
-                                         )                                    &   
-                  ) * ddy                                                     &
-               +  ( w_comp                                                    &
-                                       * ( ibit24 + ibit25 + ibit26 )         &
-                - ( w(k-1,j-1,i) + w(k-1,j,i) )                               &
-                                       * ( IBITS(wall_flags_0(k-1,j,i),24,1)  &
-                                         + IBITS(wall_flags_0(k-1,j,i),25,1)  &
-                                         + IBITS(wall_flags_0(k-1,j,i),26,1)  &
-                                         )                                    &
-                   ) * ddzw(k)   &
-                ) * 0.5_wp
-
-
-                tend(k,j,i) = tend(k,j,i) - (                                 &
-                       ( flux_r(k) + diss_r(k)                                &
-                     -   swap_flux_x_local_v(k,j) - swap_diss_x_local_v(k,j)  &
-                       ) * ddx                                                &
-                     + ( flux_n(k) + diss_n(k)                                &
-                     -   swap_flux_y_local_v(k) - swap_diss_y_local_v(k)      &
-                       ) * ddy                                                &
-                     + ( flux_t(k) + diss_t(k)                                &
-                     -   flux_d    - diss_d                                   &
-                       ) * ddzw(k)                                            &
-                                            )  + v(k,j,i) * div
-
-                swap_flux_x_local_v(k,j) = flux_r(k)
-                swap_diss_x_local_v(k,j) = diss_r(k)
-                swap_flux_y_local_v(k)   = flux_n(k)
-                swap_diss_y_local_v(k)   = diss_n(k)
-                flux_d                   = flux_t(k)
-                diss_d                   = diss_t(k)
-
-!
-!--             Statistical Evaluation of v'v'. The factor has to be applied
-!--             for right evaluation when gallilei_trans = .T. .
-                sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                     &
-                      + ( flux_n(k)                                           &
-                      * ( v_comp(k) - 2.0_wp * hom(k,1,2,0) )                    &
-                      / ( v_comp(k) - gv + 1.0E-20_wp )                       &
-                      +   diss_n(k)                                           &
-                      *   ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0) )               &
-                      / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) )               &
-                      *   weight_substep(intermediate_timestep_count)
-!
-!--              Statistical Evaluation of w'v'.
-                 sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                  &
-                              + ( flux_t(k) + diss_t(k) )                     &
-                              *   weight_substep(intermediate_timestep_count)
-
-             ENDDO
-
-             DO  k = nzb_max+1, nzt
-
-                u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
-                flux_r(k) = u_comp * (                                        &
-                      37.0_wp * ( v(k,j,i+1) + v(k,j,i)   )                      &
-                    -  8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) )                      &
-                    +           ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_5
-
-                diss_r(k) = - ABS( u_comp ) * (                               &
-                      10.0_wp * ( v(k,j,i+1) - v(k,j,i) )                        &
-                    -  5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) )                      &
-                    +           ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_5
-
-
-                v_comp(k) = v(k,j+1,i) + v(k,j,i)
-                flux_n(k) = ( v_comp(k) - gv ) * (                            &
-                      37.0_wp * ( v(k,j+1,i) + v(k,j,i)   )                      &
-                    -  8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) )                      &
-                      +         ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_5
-
-                diss_n(k) = - ABS( v_comp(k) - gv ) * (                       &
-                      10.0_wp * ( v(k,j+1,i) - v(k,j,i)   )                      &
-                    -  5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) )                      &
-                    +           ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_5
-!
-!--             k index has to be modified near bottom and top, else array
-!--             subscripts will be exceeded.
-                ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
-                ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
-                ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
-
-                k_ppp = k + 3 * ibit26
-                k_pp  = k + 2 * ( 1 - ibit24  )
-                k_mm  = k - 2 * ibit26
-
-                w_comp    = w(k,j-1,i) + w(k,j,i)
-                flux_t(k) = w_comp  * (                                      &
-                          ( 37.0_wp * ibit26 * adv_mom_5                        &
-                       +     7.0_wp * ibit25 * adv_mom_3                        &
-                       +              ibit24 * adv_mom_1                        &
-                          ) *                                                &
-                             ( v(k+1,j,i)   + v(k,j,i)    )                  &
-                   -      (  8.0_wp * ibit26 * adv_mom_5                        &
-                       +              ibit25 * adv_mom_3                        &
-                          ) *                                                &
-                             ( v(k_pp,j,i)  + v(k-1,j,i)  )                  &
-                   +      (           ibit26 * adv_mom_5                        &
-                          ) *                                                &
-                             ( v(k_ppp,j,i) + v(k_mm,j,i) )                  &
-                                      )
-
-                diss_t(k) = - ABS( w_comp ) * (                              &
-                          ( 10.0_wp * ibit26 * adv_mom_5                        &
-                       +     3.0_wp * ibit25 * adv_mom_3                        &
-                       +              ibit24 * adv_mom_1                        &
-                          ) *                                                &
-                             ( v(k+1,j,i)   - v(k,j,i)    )                  &
-                   -      (  5.0_wp * ibit26 * adv_mom_5                        &
-                       +              ibit25 * adv_mom_3                        &
-                          ) *                                                &
-                             ( v(k_pp,j,i)  - v(k-1,j,i)  )                  &
-                   +      (           ibit26 * adv_mom_5                        &
-                          ) *                                                &
-                             ( v(k_ppp,j,i) - v(k_mm,j,i) )                  &
-                                               )
-!
-!--             Calculate the divergence of the velocity field. A respective
-!--             correction is needed to overcome numerical instabilities caused
-!--             by a not sufficient reduction of divergences near topography.
-                div = ( ( u_comp + gu - ( u(k,j-1,i)   + u(k,j,i)   ) ) * ddx &
-                     +  ( v_comp(k)   - ( v(k,j,i)     + v(k,j-1,i) ) ) * ddy &
-                     +  ( w_comp      - ( w(k-1,j-1,i) + w(k-1,j,i) ) )       &
-                                                                    * ddzw(k) &
-                      ) * 0.5_wp
- 
-                tend(k,j,i) = tend(k,j,i) - (                                 &
-                       ( flux_r(k) + diss_r(k)                                &
-                     -   swap_flux_x_local_v(k,j) - swap_diss_x_local_v(k,j)  &
-                       ) * ddx                                                &
-                     + ( flux_n(k) + diss_n(k)                                &
-                     -   swap_flux_y_local_v(k) - swap_diss_y_local_v(k)      &
-                       ) * ddy                                                &
-                     + ( flux_t(k) + diss_t(k)                                &
-                     -   flux_d    - diss_d                                   &
-                       ) * ddzw(k)                                            &
-                                            )  + v(k,j,i) * div
-
-                swap_flux_x_local_v(k,j) = flux_r(k)
-                swap_diss_x_local_v(k,j) = diss_r(k)
-                swap_flux_y_local_v(k)   = flux_n(k)
-                swap_diss_y_local_v(k)   = diss_n(k)
-                flux_d                   = flux_t(k)
-                diss_d                   = diss_t(k)
-
-!
-!--             Statistical Evaluation of v'v'. The factor has to be applied
-!--             for right evaluation when gallilei_trans = .T. .
-                sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                     &
-                         + ( flux_n(k)                                        &
-                         * ( v_comp(k) - 2.0_wp * hom(k,1,2,0) )                 &
-                         / ( v_comp(k) - gv + 1.0E-20_wp )                    &
-                         +   diss_n(k)                                        &
-                         *   ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0) )            &
-                         / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) )            &
-                         *   weight_substep(intermediate_timestep_count)
-!
-!--             Statistical Evaluation of w'v'.
-                sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                    &
-                              + ( flux_t(k) + diss_t(k) )                      &
-                              *   weight_substep(intermediate_timestep_count)
-
-             ENDDO
-          ENDDO
-       ENDDO
-       sums_vs2_ws_l(nzb,tn) = sums_vs2_ws_l(nzb+1,tn)
-
-
-    END SUBROUTINE advec_v_ws
-    
-    
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Advection of v - Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_v_ws_acc
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, tend, u, v, w
-
-       USE constants,                                                          &
-           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
-
-       USE control_parameters,                                                 &
-           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
-                  nzb_max, nzt, wall_flags_0
-           
-       USE kinds
-       
-!        USE statistics,                                                       &
-!            ONLY:  hom, sums_vs2_ws_l, sums_wsvs_ws_l, weight_substep
-
-       IMPLICIT NONE
-
-
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  ibit18 !<
-       INTEGER(iwp) ::  ibit19 !<
-       INTEGER(iwp) ::  ibit20 !<
-       INTEGER(iwp) ::  ibit21 !<
-       INTEGER(iwp) ::  ibit22 !<
-       INTEGER(iwp) ::  ibit23 !<
-       INTEGER(iwp) ::  ibit24 !<
-       INTEGER(iwp) ::  ibit25 !<
-       INTEGER(iwp) ::  ibit26 !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  k      !<
-       INTEGER(iwp) ::  k_mm   !<
-       INTEGER(iwp) ::  k_mmm  !<
-       INTEGER(iwp) ::  k_pp   !<
-       INTEGER(iwp) ::  k_ppp  !<
-       INTEGER(iwp) ::  tn = 0 !<
-
-       REAL(wp)    ::  diss_d   !<
-       REAL(wp)    ::  diss_l   !<
-       REAL(wp)    ::  diss_n   !<
-       REAL(wp)    ::  diss_r   !<
-       REAL(wp)    ::  diss_s   !<
-       REAL(wp)    ::  diss_t   !<
-       REAL(wp)    ::  div      !<
-       REAL(wp)    ::  flux_d   !<
-       REAL(wp)    ::  flux_l   !<
-       REAL(wp)    ::  flux_n   !<
-       REAL(wp)    ::  flux_r   !<
-       REAL(wp)    ::  flux_s   !<
-       REAL(wp)    ::  flux_t   !<
-       REAL(wp)    ::  gu       !<
-       REAL(wp)    ::  gv       !<
-       REAL(wp)    ::  u_comp   !<
-       REAL(wp)    ::  u_comp_l !<
-       REAL(wp)    ::  v_comp   !<
-       REAL(wp)    ::  v_comp_s !<
-       REAL(wp)    ::  w_comp   !<
-
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-
-!
-!--    Computation of fluxes and tendency terms
-       !$acc kernels present( ddzw, tend, u, v, w, wall_flags_0 )
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-             DO  k = nzb+1, nzt
-
-                ibit20 = IBITS(wall_flags_0(k,j,i-1),20,1)
-                ibit19 = IBITS(wall_flags_0(k,j,i-1),19,1)
-                ibit18 = IBITS(wall_flags_0(k,j,i-1),18,1)
-
-                u_comp_l                 = u(k,j-1,i) + u(k,j,i) - gu
-                flux_l                   = u_comp_l * (                          &
-                                      ( 37.0_wp * ibit20 * adv_mom_5              &
-                                   +     7.0_wp * ibit19 * adv_mom_3              &
-                                   +              ibit18 * adv_mom_1              &
-                                      ) *                                      &
-                                     ( v(k,j,i)   + v(k,j,i-1) )               &
-                               -      (  8.0_wp * ibit20 * adv_mom_5              &
-                                   +              ibit19 * adv_mom_3              &
-                                      ) *                                      &
-                                     ( v(k,j,i+1) + v(k,j,i-2) )               &
-                               +      (           ibit20 * adv_mom_5              &
-                                      ) *                                      &
-                                     ( v(k,j,i+2) + v(k,j,i-3) )               &
-                                                 )
-
-                diss_l                   = - ABS( u_comp_l ) * (                 &
-                                      ( 10.0_wp * ibit20 * adv_mom_5              &
-                                   +     3.0_wp * ibit19 * adv_mom_3              &
-                                   +              ibit18 * adv_mom_1              &
-                                      ) *                                      &
-                                     ( v(k,j,i)   - v(k,j,i-1) )               &
-                               -      (  5.0_wp * ibit20 * adv_mom_5              &
-                                   +              ibit19 * adv_mom_3              &
-                                      ) *                                      &
-                                     ( v(k,j,i+1) - v(k,j,i-2) )               &
-                               +      (           ibit20 * adv_mom_5              &
-                                      ) *                                      &
-                                     ( v(k,j,i+2) - v(k,j,i-3) )               &
-                                                           )
-
-                ibit20 = IBITS(wall_flags_0(k,j,i),20,1)
-                ibit19 = IBITS(wall_flags_0(k,j,i),19,1)
-                ibit18 = IBITS(wall_flags_0(k,j,i),18,1)
-
-                u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
-                flux_r    = u_comp * (                                       &
-                          ( 37.0_wp * ibit20 * adv_mom_5                        &
-                       +     7.0_wp * ibit19 * adv_mom_3                        &
-                       +              ibit18 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( v(k,j,i+1) + v(k,j,i)   )                 &
-                   -      (  8.0_wp * ibit20 * adv_mom_5                        &
-                       +              ibit19 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( v(k,j,i+2) + v(k,j,i-1) )                 &
-                   +      (           ibit20 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( v(k,j,i+3) + v(k,j,i-2) )                 &
-                                     )
-
-                diss_r    = - ABS( u_comp ) * (                              &
-                          ( 10.0_wp * ibit20 * adv_mom_5                        &
-                       +     3.0_wp * ibit19 * adv_mom_3                        &
-                       +              ibit18 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( v(k,j,i+1) - v(k,j,i)  )                  &
-                   -      (  5.0_wp * ibit20 * adv_mom_5                        &
-                       +              ibit19 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( v(k,j,i+2) - v(k,j,i-1) )                 &
-                   +      (           ibit20 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( v(k,j,i+3) - v(k,j,i-2) )                 &
-                                              )
-
-                ibit23 = IBITS(wall_flags_0(k,j-1,i),23,1)
-                ibit22 = IBITS(wall_flags_0(k,j-1,i),22,1)
-                ibit21 = IBITS(wall_flags_0(k,j-1,i),21,1)
-
-
-                v_comp_s              = v(k,j,i) + v(k,j-1,i) - gv
-                flux_s                = v_comp_s    * (                       &
-                                   ( 37.0_wp * ibit23 * adv_mom_5                &
-                                +     7.0_wp * ibit22 * adv_mom_3                &
-                                +              ibit21 * adv_mom_1                &
-                                   ) *                                        &
-                                     ( v(k,j,i)   + v(k,j-1,i) )              &
-                            -      (  8.0_wp * ibit23 * adv_mom_5                &
-                                +              ibit22 * adv_mom_3                &
-                                   ) *                                        &
-                                     ( v(k,j+1,i) + v(k,j-2,i) )              &
-                            +      (           ibit23 * adv_mom_5                &
-                                   ) *                                        &
-                                     ( v(k,j+2,i) + v(k,j-3,i) )              &
-                                                 )
-
-                diss_s                = - ABS( v_comp_s ) * (                 &
-                                   ( 10.0_wp * ibit23 * adv_mom_5                &
-                                +     3.0_wp * ibit22 * adv_mom_3                &
-                                +              ibit21 * adv_mom_1                &
-                                   ) *                                        &
-                                     ( v(k,j,i)   - v(k,j-1,i) )              &
-                            -      (  5.0_wp * ibit23 * adv_mom_5                &
-                                +              ibit22 * adv_mom_3                &
-                                   ) *                                        &
-                                     ( v(k,j+1,i) - v(k,j-2,i) )              &
-                            +      (           ibit23 * adv_mom_5                &
-                                   ) *                                        &
-                                     ( v(k,j+2,i) - v(k,j-3,i) )              &
-                                                          )
-
-                ibit23 = IBITS(wall_flags_0(k,j,i),23,1)
-                ibit22 = IBITS(wall_flags_0(k,j,i),22,1)
-                ibit21 = IBITS(wall_flags_0(k,j,i),21,1)
-
-                v_comp = v(k,j+1,i) + v(k,j,i)
-                flux_n = ( v_comp - gv ) * (                                 &
-                          ( 37.0_wp * ibit23 * adv_mom_5                        &
-                       +     7.0_wp * ibit22 * adv_mom_3                        &
-                       +              ibit21 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( v(k,j+1,i) + v(k,j,i)   )                 &
-                   -      (  8.0_wp * ibit23 * adv_mom_5                        &
-                       +              ibit22 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( v(k,j+2,i) + v(k,j-1,i) )                 &
-                   +      (           ibit23 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( v(k,j+3,i) + v(k,j-2,i) )                 &
-                                     )
-
-                diss_n = - ABS( v_comp - gv ) * (                         &
-                          ( 10.0_wp * ibit23 * adv_mom_5                        &
-                       +     3.0_wp * ibit22 * adv_mom_3                        &
-                       +              ibit21 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( v(k,j+1,i) - v(k,j,i)  )                  &
-                   -      (  5.0_wp * ibit23 * adv_mom_5                        &
-                       +              ibit22 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( v(k,j+2,i) - v(k,j-1,i) )                 &
-                   +      (           ibit23 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( v(k,j+3,i) - v(k,j-2,i) )                 &
-                                                     )
-
-                ibit26 = IBITS(wall_flags_0(k-1,j,i),26,1)
-                ibit25 = IBITS(wall_flags_0(k-1,j,i),25,1)
-                ibit24 = IBITS(wall_flags_0(k-1,j,i),24,1)
-
-                k_pp  = k + 2 * ibit26
-                k_mm  = k - 2 * ( ibit25 + ibit26 )
-                k_mmm = k - 3 * ibit26
-
-                w_comp    = w(k-1,j-1,i) + w(k-1,j,i)
-                flux_d    = w_comp  * (                                      &
-                          ( 37.0_wp * ibit26 * adv_mom_5                        &
-                       +     7.0_wp * ibit25 * adv_mom_3                        &
-                       +              ibit24 * adv_mom_1                        &
-                          ) *                                                &
-                             ( v(k,j,i)     + v(k-1,j,i)  )                  &
-                   -      (  8.0_wp * ibit26 * adv_mom_5                        &
-                       +              ibit25 * adv_mom_3                        &
-                          ) *                                                &
-                             ( v(k+1,j,i)  + v(k_mm,j,i)  )                  &
-                   +      (           ibit26 * adv_mom_5                        &
-                          ) *                                                &
-                             ( v(k_pp,j,i) + v(k_mmm,j,i) )                  &
-                                      )
-
-                diss_d    = - ABS( w_comp ) * (                              &
-                          ( 10.0_wp * ibit26 * adv_mom_5                        &
-                       +     3.0_wp * ibit25 * adv_mom_3                        &
-                       +              ibit24 * adv_mom_1                        &
-                          ) *                                                &
-                             ( v(k,j,i)     - v(k-1,j,i)  )                  &
-                   -      (  5.0_wp * ibit26 * adv_mom_5                        &
-                       +              ibit25 * adv_mom_3                        &
-                          ) *                                                &
-                             ( v(k+1,j,i)  - v(k_mm,j,i)  )                  &
-                   +      (           ibit26 * adv_mom_5                        &
-                          ) *                                                &
-                             ( v(k_pp,j,i) - v(k_mmm,j,i) )                  &
-                                               )
-!
-!--             k index has to be modified near bottom and top, else array
-!--             subscripts will be exceeded.
-                ibit26 = IBITS(wall_flags_0(k,j,i),26,1)
-                ibit25 = IBITS(wall_flags_0(k,j,i),25,1)
-                ibit24 = IBITS(wall_flags_0(k,j,i),24,1)
-
-                k_ppp = k + 3 * ibit26
-                k_pp  = k + 2 * ( 1 - ibit24  )
-                k_mm  = k - 2 * ibit26
-
-                w_comp    = w(k,j-1,i) + w(k,j,i)
-                flux_t    = w_comp  * (                                      &
-                          ( 37.0_wp * ibit26 * adv_mom_5                        &
-                       +     7.0_wp * ibit25 * adv_mom_3                        &
-                       +              ibit24 * adv_mom_1                        &
-                          ) *                                                &
-                             ( v(k+1,j,i)   + v(k,j,i)    )                  &
-                   -      (  8.0_wp * ibit26 * adv_mom_5                        &
-                       +              ibit25 * adv_mom_3                        &
-                          ) *                                                &
-                             ( v(k_pp,j,i)  + v(k-1,j,i)  )                  &
-                   +      (           ibit26 * adv_mom_5                        &
-                          ) *                                                &
-                             ( v(k_ppp,j,i) + v(k_mm,j,i) )                  &
-                                      )
-
-                diss_t    = - ABS( w_comp ) * (                              &
-                          ( 10.0_wp * ibit26 * adv_mom_5                        &
-                       +     3.0_wp * ibit25 * adv_mom_3                        &
-                       +              ibit24 * adv_mom_1                        &
-                          ) *                                                &
-                             ( v(k+1,j,i)   - v(k,j,i)    )                  &
-                   -      (  5.0_wp * ibit26 * adv_mom_5                        &
-                       +              ibit25 * adv_mom_3                        &
-                          ) *                                                &
-                             ( v(k_pp,j,i)  - v(k-1,j,i)  )                  &
-                   +      (           ibit26 * adv_mom_5                        &
-                          ) *                                                &
-                             ( v(k_ppp,j,i) - v(k_mm,j,i) )                  &
-                                               )
-!
-!--             Calculate the divergence of the velocity field. A respective
-!--             correction is needed to overcome numerical instabilities caused
-!--             by a not sufficient reduction of divergences near topography.
-                div = ( ( ( u_comp     + gu )                                 &
-                                       * ( ibit18 + ibit19 + ibit20 )         &
-                - ( u(k,j-1,i)   + u(k,j,i) )                                 &
-                                       * ( IBITS(wall_flags_0(k,j,i-1),18,1)  &
-                                         + IBITS(wall_flags_0(k,j,i-1),19,1)  &
-                                         + IBITS(wall_flags_0(k,j,i-1),20,1)  &
-                                         )                                    &   
-                  ) * ddx                                                     &
-               +  ( v_comp                                                    &
-                                       * ( ibit21 + ibit22 + ibit23 )         &
-                - ( v(k,j,i)     + v(k,j-1,i) )                               &
-                                       * ( IBITS(wall_flags_0(k,j-1,i),21,1)  &
-                                         + IBITS(wall_flags_0(k,j-1,i),22,1)  &
-                                         + IBITS(wall_flags_0(k,j-1,i),23,1)  &
-                                         )                                    &   
-                  ) * ddy                                                     &
-               +  ( w_comp                                                    &
-                                       * ( ibit24 + ibit25 + ibit26 )         &
-                - ( w(k-1,j-1,i) + w(k-1,j,i) )                               &
-                                       * ( IBITS(wall_flags_0(k-1,j,i),24,1)  &
-                                         + IBITS(wall_flags_0(k-1,j,i),25,1)  &
-                                         + IBITS(wall_flags_0(k-1,j,i),26,1)  &
-                                         )                                    &
-                   ) * ddzw(k)   &
-                ) * 0.5_wp
-
-
-                tend(k,j,i) = - (                                              &
-                               ( flux_r + diss_r - flux_l - diss_l ) * ddx     &
-                             + ( flux_n + diss_n - flux_s - diss_s ) * ddy     &
-                             + ( flux_t + diss_t - flux_d - diss_d ) * ddzw(k) &
-                                ) + div * v(k,j,i)
-
-
-!++
-!--             Statistical Evaluation of v'v'. The factor has to be applied
-!--             for right evaluation when gallilei_trans = .T. .
-!                sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn)                  &
-!                      + ( flux_n                                           &
-!                      * ( v_comp - 2.0_wp * hom(k,1,2,0) )                    &
-!                      / ( v_comp - gv + 1.0E-20_wp )                       &
-!                      +   diss_n                                           &
-!                      *   ABS( v_comp - 2.0_wp * hom(k,1,2,0) )               &
-!                      / ( ABS( v_comp - gv ) +1.0E-20_wp ) )               &
-!                      *   weight_substep(intermediate_timestep_count)
-!
-!--              Statistical Evaluation of w'v'.
-!                 sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                &
-!                              + ( flux_t + diss_t )                         &
-!                              *   weight_substep(intermediate_timestep_count)
-
-             ENDDO
-          ENDDO
-       ENDDO
-       !$acc end kernels
-
-!++
-!       sums_vs2_ws_l(nzb,tn) = sums_vs2_ws_l(nzb+1,tn)
-
-    END SUBROUTINE advec_v_ws_acc
-    
-    
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Advection of w - Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_w_ws
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, tend, u, v, w
-
-       USE constants,                                                          &
-           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
-
-       USE control_parameters,                                                 &
-           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0,         &
-                  wall_flags_00
-
-       USE kinds
-       
-       USE statistics,                                                         &
-           ONLY:  hom, sums_ws2_ws_l, weight_substep
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  ibit27 !<
-       INTEGER(iwp) ::  ibit28 !<
-       INTEGER(iwp) ::  ibit29 !<
-       INTEGER(iwp) ::  ibit30 !<
-       INTEGER(iwp) ::  ibit31 !<
-       INTEGER(iwp) ::  ibit32 !<
-       INTEGER(iwp) ::  ibit33 !<
-       INTEGER(iwp) ::  ibit34 !<
-       INTEGER(iwp) ::  ibit35 !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  k      !<
-       INTEGER(iwp) ::  k_mm   !<
-       INTEGER(iwp) ::  k_pp   !<
-       INTEGER(iwp) ::  k_ppp  !<
-       INTEGER(iwp) ::  tn = 0 !<
-       
-       REAL(wp)    ::  diss_d !<
-       REAL(wp)    ::  div    !<
-       REAL(wp)    ::  flux_d !<
-       REAL(wp)    ::  gu     !<
-       REAL(wp)    ::  gv     !<
-       REAL(wp)    ::  u_comp !<
-       REAL(wp)    ::  v_comp !<
-       REAL(wp)    ::  w_comp !<
-       
-       REAL(wp), DIMENSION(nzb:nzt)    ::  diss_t !<
-       REAL(wp), DIMENSION(nzb:nzt)    ::  flux_t !<
-       
-       REAL(wp), DIMENSION(nzb+1:nzt)  ::  diss_n !<
-       REAL(wp), DIMENSION(nzb+1:nzt)  ::  diss_r !<
-       REAL(wp), DIMENSION(nzb+1:nzt)  ::  flux_n !<
-       REAL(wp), DIMENSION(nzb+1:nzt)  ::  flux_r !<
-       REAL(wp), DIMENSION(nzb+1:nzt)  ::  swap_diss_y_local_w !<
-       REAL(wp), DIMENSION(nzb+1:nzt)  ::  swap_flux_y_local_w !<
-       
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_w !<
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_flux_x_local_w !<
- 
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-!
-!--   compute the whole left boundary of the processor domain
-       i = nxl
-       DO  j = nys, nyn
-          DO  k = nzb+1, nzb_max
-
-             ibit29 = IBITS(wall_flags_0(k,j,i-1),29,1)
-             ibit28 = IBITS(wall_flags_0(k,j,i-1),28,1)
-             ibit27 = IBITS(wall_flags_0(k,j,i-1),27,1)
-
-             u_comp                   = u(k+1,j,i) + u(k,j,i) - gu
-             swap_flux_x_local_w(k,j) = u_comp * (                             &
-                                      ( 37.0_wp * ibit29 * adv_mom_5              &
-                                   +     7.0_wp * ibit28 * adv_mom_3              &
-                                   +              ibit27 * adv_mom_1              &
-                                      ) *                                      &
-                                     ( w(k,j,i)   + w(k,j,i-1) )               &
-                               -      (  8.0_wp * ibit29 * adv_mom_5              &
-                                   +              ibit28 * adv_mom_3              &
-                                      ) *                                      &
-                                     ( w(k,j,i+1) + w(k,j,i-2) )               &
-                               +      (           ibit29 * adv_mom_5              &
-                                      ) *                                      &
-                                     ( w(k,j,i+2) + w(k,j,i-3) )               &
-                                                 )
-
-               swap_diss_x_local_w(k,j) = - ABS( u_comp ) * (                  &
-                                        ( 10.0_wp * ibit29 * adv_mom_5            &
-                                     +     3.0_wp * ibit28 * adv_mom_3            &
-                                     +              ibit27 * adv_mom_1            &
-                                        ) *                                    &
-                                     ( w(k,j,i)   - w(k,j,i-1) )               &
-                                 -      (  5.0_wp * ibit29 * adv_mom_5            &
-                                     +              ibit28 * adv_mom_3            &
-                                        ) *                                    &
-                                     ( w(k,j,i+1) - w(k,j,i-2) )               &
-                                 +      (           ibit29 * adv_mom_5            &
-                                        ) *                                    &
-                                     ( w(k,j,i+2) - w(k,j,i-3) )               &
-                                                            )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             u_comp                   = u(k+1,j,i) + u(k,j,i) - gu
-             swap_flux_x_local_w(k,j) = u_comp * (                             &
-                            37.0_wp * ( w(k,j,i) + w(k,j,i-1)   )                 &
-                          -  8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) )                 &
-                          +           ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5
-             swap_diss_x_local_w(k,j) = - ABS( u_comp ) * (                    &
-                            10.0_wp * ( w(k,j,i) - w(k,j,i-1)   )                 &
-                          -  5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) )                 &
-                          +           ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5
-
-          ENDDO
-
-       ENDDO
-
-       DO i = nxl, nxr
-
-          j = nys
-          DO  k = nzb+1, nzb_max
-
-             ibit32 = IBITS(wall_flags_00(k,j-1,i),0,1)
-             ibit31 = IBITS(wall_flags_0(k,j-1,i),31,1)
-             ibit30 = IBITS(wall_flags_0(k,j-1,i),30,1)
-
-             v_comp                 = v(k+1,j,i) + v(k,j,i) - gv
-             swap_flux_y_local_w(k) = v_comp * (                              &
-                                    ( 37.0_wp * ibit32 * adv_mom_5               &
-                                 +     7.0_wp * ibit31 * adv_mom_3               &
-                                 +              ibit30 * adv_mom_1               &
-                                    ) *                                        &
-                                     ( w(k,j,i)   + w(k,j-1,i) )              &
-                             -      (  8.0_wp * ibit32 * adv_mom_5               &
-                                 +              ibit31 * adv_mom_3               &
-                                    ) *                                       &
-                                     ( w(k,j+1,i) + w(k,j-2,i) )              &
-                             +      (           ibit32 * adv_mom_5               &
-                                    ) *                                       &
-                                     ( w(k,j+2,i) + w(k,j-3,i) )              &
-                                               )
-
-             swap_diss_y_local_w(k) = - ABS( v_comp ) * (                     &
-                                    ( 10.0_wp * ibit32 * adv_mom_5               &
-                                 +     3.0_wp * ibit31 * adv_mom_3               &
-                                 +              ibit30 * adv_mom_1               &
-                                    ) *                                       &
-                                     ( w(k,j,i)   - w(k,j-1,i) )              &
-                             -      (  5.0_wp * ibit32 * adv_mom_5               &
-                                 +              ibit31 * adv_mom_3               &
-                                    ) *                                       &
-                                     ( w(k,j+1,i) - w(k,j-2,i) )              &
-                             +      (           ibit32 * adv_mom_5               &
-                                    ) *                                       &
-                                     ( w(k,j+2,i) - w(k,j-3,i) )              &
-                                                        )
-
-          ENDDO
-
-          DO  k = nzb_max+1, nzt
-
-             v_comp                 = v(k+1,j,i) + v(k,j,i) - gv
-             swap_flux_y_local_w(k) = v_comp * (                              &
-                           37.0_wp * ( w(k,j,i) + w(k,j-1,i)   )                 &
-                         -  8.0_wp * ( w(k,j+1,i) +w(k,j-2,i)  )                 &
-                         +           ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5
-             swap_diss_y_local_w(k) = - ABS( v_comp ) * (                     &
-                           10.0_wp * ( w(k,j,i) - w(k,j-1,i)   )                 &
-                         -  5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) )                 &
-                         +           ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5
-
-          ENDDO
-
-          DO  j = nys, nyn
-
-!
-!--          The lower flux has to be calculated explicetely for the tendency
-!--          at the first w-level. For topography wall this is done implicitely
-!--          by wall_flags_0.
-             k         = nzb + 1
-             w_comp    = w(k,j,i) + w(k-1,j,i)
-             flux_t(0) = w_comp       * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1
-             diss_t(0) = -ABS(w_comp) * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1
-             flux_d    = flux_t(0)
-             diss_d    = diss_t(0)
-
-             DO  k = nzb+1, nzb_max
-
-                ibit29 = IBITS(wall_flags_0(k,j,i),29,1)
-                ibit28 = IBITS(wall_flags_0(k,j,i),28,1)
-                ibit27 = IBITS(wall_flags_0(k,j,i),27,1)
-
-                u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
-                flux_r(k) = u_comp * (                                       &
-                          ( 37.0_wp * ibit29 * adv_mom_5                        &
-                       +     7.0_wp * ibit28 * adv_mom_3                        &
-                       +              ibit27 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( w(k,j,i+1) + w(k,j,i)   )                 &
-                   -      (  8.0_wp * ibit29 * adv_mom_5                        &
-                       +              ibit28 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( w(k,j,i+2) + w(k,j,i-1) )                 &
-                   +      (           ibit29 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( w(k,j,i+3) + w(k,j,i-2) )                 &
-                                     )
-
-                diss_r(k) = - ABS( u_comp ) * (                              &
-                          ( 10.0_wp * ibit29 * adv_mom_5                        &
-                       +     3.0_wp * ibit28 * adv_mom_3                        &
-                       +              ibit27 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( w(k,j,i+1) - w(k,j,i)  )                  &
-                   -      (  5.0_wp * ibit29 * adv_mom_5                        &
-                       +              ibit28 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( w(k,j,i+2) - w(k,j,i-1) )                 &
-                   +      (           ibit29 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( w(k,j,i+3) - w(k,j,i-2) )                 &
-                                              )
-
-                ibit32 = IBITS(wall_flags_00(k,j,i),0,1)
-                ibit31 = IBITS(wall_flags_0(k,j,i),31,1)
-                ibit30 = IBITS(wall_flags_0(k,j,i),30,1)
-
-                v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
-                flux_n(k) = v_comp * (                                       &
-                          ( 37.0_wp * ibit32 * adv_mom_5                        &
-                       +     7.0_wp * ibit31 * adv_mom_3                        &
-                       +              ibit30 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( w(k,j+1,i) + w(k,j,i)   )                 &
-                   -      (  8.0_wp * ibit32 * adv_mom_5                        &
-                       +              ibit31 * adv_mom_3                        &
-                          ) *                                                 &
-                                 ( w(k,j+2,i) + w(k,j-1,i) )                 &
-                   +      (           ibit32 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( w(k,j+3,i) + w(k,j-2,i) )                 &
-                                     )
-
-                diss_n(k) = - ABS( v_comp ) * (                              &
-                          ( 10.0_wp * ibit32 * adv_mom_5                        &
-                       +     3.0_wp * ibit31 * adv_mom_3                        &
-                       +              ibit30 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( w(k,j+1,i) - w(k,j,i)  )                  &
-                   -      (  5.0_wp * ibit32 * adv_mom_5                        &
-                       +              ibit31 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( w(k,j+2,i) - w(k,j-1,i) )                 &
-                   +      (           ibit32 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( w(k,j+3,i) - w(k,j-2,i) )                 &
-                                              )
-!
-!--             k index has to be modified near bottom and top, else array
-!--             subscripts will be exceeded.
-                ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
-                ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
-                ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
-
-                k_ppp = k + 3 * ibit35
-                k_pp  = k + 2 * ( 1 - ibit33  )
-                k_mm  = k - 2 * ibit35
-
-                w_comp    = w(k+1,j,i) + w(k,j,i)
-                flux_t(k) = w_comp  * (                                      &
-                          ( 37.0_wp * ibit35 * adv_mom_5                        &
-                       +     7.0_wp * ibit34 * adv_mom_3                        &
-                       +              ibit33 * adv_mom_1                        &
-                          ) *                                                &
-                             ( w(k+1,j,i)  + w(k,j,i)     )                  &
-                   -      (  8.0_wp * ibit35 * adv_mom_5                        &
-                       +              ibit34 * adv_mom_3                        &
-                          ) *                                                &
-                             ( w(k_pp,j,i)  + w(k-1,j,i)  )                  &
-                   +      (           ibit35 * adv_mom_5                        &
-                          ) *                                                &
-                             ( w(k_ppp,j,i) + w(k_mm,j,i) )                  &
-                                       )
-
-                diss_t(k) = - ABS( w_comp ) * (                              &
-                          ( 10.0_wp * ibit35 * adv_mom_5                        &
-                       +     3.0_wp * ibit34 * adv_mom_3                        &
-                       +              ibit33 * adv_mom_1                        &
-                          ) *                                                &
-                             ( w(k+1,j,i)   - w(k,j,i)    )                  &
-                   -      (  5.0_wp * ibit35 * adv_mom_5                        &
-                       +              ibit34 * adv_mom_3                        &
-                          ) *                                                &
-                             ( w(k_pp,j,i)  - w(k-1,j,i)  )                  &
-                   +      (           ibit35 * adv_mom_5                        &
-                          ) *                                                &
-                             ( w(k_ppp,j,i) - w(k_mm,j,i) )                  &
-                                               )
-!
-!--             Calculate the divergence of the velocity field. A respective
-!--             correction is needed to overcome numerical instabilities caused
-!--             by a not sufficient reduction of divergences near topography.
-                div = ( ( ( u_comp + gu ) * ( ibit27 + ibit28 + ibit29 )      &
-                  - ( u(k+1,j,i) + u(k,j,i)   )                               & 
-                                    * ( IBITS(wall_flags_0(k,j,i-1),27,1)     &
-                                      + IBITS(wall_flags_0(k,j,i-1),28,1)     &
-                                      + IBITS(wall_flags_0(k,j,i-1),29,1)     &
-                                      )                                       &
-                  ) * ddx                                                     &
-              +   ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 )            & 
-                  - ( v(k+1,j,i) + v(k,j,i)   )                               &
-                                    * ( IBITS(wall_flags_0(k,j-1,i),30,1)     &
-                                      + IBITS(wall_flags_0(k,j-1,i),31,1)     &
-                                      + IBITS(wall_flags_00(k,j-1,i),0,1)     &
-                                      )                                       &
-                  ) * ddy                                                     &
-              +   ( w_comp          * ( ibit33 + ibit34 + ibit35 )            &
-                - ( w(k,j,i)   + w(k-1,j,i)   )                               &
-                                    * ( IBITS(wall_flags_00(k-1,j,i),1,1)     &
-                                      + IBITS(wall_flags_00(k-1,j,i),2,1)     &
-                                      + IBITS(wall_flags_00(k-1,j,i),3,1)     &
-                                      )                                       & 
-                  ) * ddzu(k+1)   &
-                ) * 0.5_wp
-
-
-
-                tend(k,j,i) = tend(k,j,i) - (                                 &
-                      ( flux_r(k) + diss_r(k)                                 &
-                    -   swap_flux_x_local_w(k,j) - swap_diss_x_local_w(k,j)   &
-                      ) * ddx                                                 &
-                    + ( flux_n(k) + diss_n(k)                                 &
-                    -   swap_flux_y_local_w(k)   - swap_diss_y_local_w(k)     &
-                      ) * ddy                                                 &
-                    + ( flux_t(k) + diss_t(k)                                 &
-                    -   flux_d    - diss_d                                    &
-                      ) * ddzu(k+1)                                           &
-                                            )  + div * w(k,j,i)
-
-                swap_flux_x_local_w(k,j) = flux_r(k)
-                swap_diss_x_local_w(k,j) = diss_r(k)
-                swap_flux_y_local_w(k)   = flux_n(k)
-                swap_diss_y_local_w(k)   = diss_n(k)
-                flux_d                   = flux_t(k)
-                diss_d                   = diss_t(k)
-
-                sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                    &
-                               + ( flux_t(k) + diss_t(k) )                    &
-                               *   weight_substep(intermediate_timestep_count)
-
-             ENDDO
-
-             DO  k = nzb_max+1, nzt
-
-                u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
-                flux_r(k) = u_comp * (                                      &
-                      37.0_wp * ( w(k,j,i+1) + w(k,j,i)   )                    &
-                    -  8.0_wp * ( w(k,j,i+2) + w(k,j,i-1) )                    &
-                    +           ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_5
-
-                diss_r(k) = - ABS( u_comp ) * (                             &
-                      10.0_wp * ( w(k,j,i+1) - w(k,j,i)   )                    &
-                    -  5.0_wp * ( w(k,j,i+2) - w(k,j,i-1) )                    &
-                    +           ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_5
-
-                v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
-                flux_n(k) = v_comp * (                                      &
-                      37.0_wp * ( w(k,j+1,i) + w(k,j,i)   )                    &
-                    -  8.0_wp * ( w(k,j+2,i) + w(k,j-1,i) )                    &
-                    +           ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_5
-
-                diss_n(k) = - ABS( v_comp ) * (                             &
-                      10.0_wp * ( w(k,j+1,i) - w(k,j,i)   )                    &
-                    -  5.0_wp * ( w(k,j+2,i) - w(k,j-1,i) )                    &
-                    +           ( w(k,j+3,i) - w(k,j-2,i) ) ) * adv_mom_5
-!
-!--             k index has to be modified near bottom and top, else array
-!--             subscripts will be exceeded.
-                ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
-                ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
-                ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
-
-                k_ppp = k + 3 * ibit35
-                k_pp  = k + 2 * ( 1 - ibit33  )
-                k_mm  = k - 2 * ibit35
-
-                w_comp    = w(k+1,j,i) + w(k,j,i)
-                flux_t(k) = w_comp  * (                                      &
-                          ( 37.0_wp * ibit35 * adv_mom_5                        &
-                       +     7.0_wp * ibit34 * adv_mom_3                        &
-                       +              ibit33 * adv_mom_1                        &
-                          ) *                                                &
-                             ( w(k+1,j,i)  + w(k,j,i)     )                  &
-                   -      (  8.0_wp * ibit35 * adv_mom_5                        &
-                       +              ibit34 * adv_mom_3                        &
-                          ) *                                                &
-                             ( w(k_pp,j,i)  + w(k-1,j,i)  )                  &
-                   +      (           ibit35 * adv_mom_5                        &
-                          ) *                                                &
-                             ( w(k_ppp,j,i) + w(k_mm,j,i) )                  &
-                                       )
-
-                diss_t(k) = - ABS( w_comp ) * (                              &
-                          ( 10.0_wp * ibit35 * adv_mom_5                        &
-                       +     3.0_wp * ibit34 * adv_mom_3                        &
-                       +              ibit33 * adv_mom_1                        &
-                          ) *                                                &
-                             ( w(k+1,j,i)   - w(k,j,i)    )                  &
-                   -      (  5.0_wp * ibit35 * adv_mom_5                        &
-                       +              ibit34 * adv_mom_3                        &
-                          ) *                                                &
-                             ( w(k_pp,j,i)  - w(k-1,j,i)  )                  &
-                   +      (           ibit35 * adv_mom_5                        &
-                          ) *                                                &
-                             ( w(k_ppp,j,i) - w(k_mm,j,i) )                  &
-                                               )
-!
-!--             Calculate the divergence of the velocity field. A respective
-!--             correction is needed to overcome numerical instabilities caused
-!--             by a not sufficient reduction of divergences near topography.
-                div = ( ( u_comp + gu - ( u(k+1,j,i) + u(k,j,i)   ) ) * ddx  &
-                    +   ( v_comp + gv - ( v(k+1,j,i) + v(k,j,i)   ) ) * ddy  &
-                    +   ( w_comp      - ( w(k,j,i)   + w(k-1,j,i) ) )        &
-                                                                 * ddzu(k+1) &
-                      ) * 0.5_wp
-
-                tend(k,j,i) = tend(k,j,i) - (                                 &
-                      ( flux_r(k) + diss_r(k)                                 &
-                    -   swap_flux_x_local_w(k,j) - swap_diss_x_local_w(k,j)   &
-                      ) * ddx                                                 &
-                    + ( flux_n(k) + diss_n(k)                                 &
-                    -   swap_flux_y_local_w(k)   - swap_diss_y_local_w(k)     &
-                      ) * ddy                                                 &
-                    + ( flux_t(k) + diss_t(k)                                 &
-                    -   flux_d    - diss_d                                    &
-                      ) * ddzu(k+1)                                           &
-                                            )  + div * w(k,j,i)
-
-                swap_flux_x_local_w(k,j) = flux_r(k)
-                swap_diss_x_local_w(k,j) = diss_r(k)
-                swap_flux_y_local_w(k)   = flux_n(k)
-                swap_diss_y_local_w(k)   = diss_n(k)
-                flux_d                   = flux_t(k)
-                diss_d                   = diss_t(k)
-
-                sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                    &
-                               + ( flux_t(k) + diss_t(k) )                    &
-                               *   weight_substep(intermediate_timestep_count)
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE advec_w_ws
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Advection of w - Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE advec_w_ws_acc
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, tend, u, v, w
-
-       USE constants,                                                          &
-           ONLY:  adv_mom_1, adv_mom_3, adv_mom_5
-
-       USE control_parameters,                                                 &
-           ONLY:  intermediate_timestep_count, u_gtrans, v_gtrans
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy
-
-       USE indices,                                                            &
-           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
-                  nzb_max, nzt, wall_flags_0, wall_flags_00
-           
-       USE kinds
-       
-!        USE statistics,                                                       &
-!            ONLY:  hom, sums_ws2_ws_l, weight_substep
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  ibit27 !<
-       INTEGER(iwp) ::  ibit28 !<
-       INTEGER(iwp) ::  ibit29 !<
-       INTEGER(iwp) ::  ibit30 !<
-       INTEGER(iwp) ::  ibit31 !<
-       INTEGER(iwp) ::  ibit32 !<
-       INTEGER(iwp) ::  ibit33 !<
-       INTEGER(iwp) ::  ibit34 !<
-       INTEGER(iwp) ::  ibit35 !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  k      !<
-       INTEGER(iwp) ::  k_mmm  !<
-       INTEGER(iwp) ::  k_mm   !<
-       INTEGER(iwp) ::  k_pp   !<
-       INTEGER(iwp) ::  k_ppp  !<
-       INTEGER(iwp) ::  tn = 0 !<
-
-       REAL(wp)    ::  diss_d   !<
-       REAL(wp)    ::  diss_l   !<
-       REAL(wp)    ::  diss_n   !<
-       REAL(wp)    ::  diss_r   !<
-       REAL(wp)    ::  diss_s   !<
-       REAL(wp)    ::  diss_t   !<
-       REAL(wp)    ::  div      !<
-       REAL(wp)    ::  flux_d   !<
-       REAL(wp)    ::  flux_l   !<
-       REAL(wp)    ::  flux_n   !<
-       REAL(wp)    ::  flux_r   !<
-       REAL(wp)    ::  flux_s   !<
-       REAL(wp)    ::  flux_t   !<
-       REAL(wp)    ::  gu       !<
-       REAL(wp)    ::  gv       !<
-       REAL(wp)    ::  u_comp   !<
-       REAL(wp)    ::  u_comp_l !<
-       REAL(wp)    ::  v_comp   !<
-       REAL(wp)    ::  v_comp_s !<
-       REAL(wp)    ::  w_comp   !<
-
-       gu = 2.0_wp * u_gtrans
-       gv = 2.0_wp * v_gtrans
-
-
-!
-!--    Computation of fluxes and tendency terms
-       !$acc kernels present( ddzu, tend, u, v, w, wall_flags_0, wall_flags_00 )
-       DO i = i_left, i_right
-          DO  j = j_south, j_north
-             DO  k = nzb+1, nzt
-
-                ibit27 = IBITS(wall_flags_0(k,j,i-1),27,1)
-                ibit28 = IBITS(wall_flags_0(k,j,i-1),28,1)
-                ibit29 = IBITS(wall_flags_0(k,j,i-1),29,1)
-
-                u_comp_l                 = u(k+1,j,i) + u(k,j,i) - gu
-                flux_l                   = u_comp_l * (                        &
-                                      ( 37.0_wp * ibit29 * adv_mom_5              &
-                                   +     7.0_wp * ibit28 * adv_mom_3              &
-                                   +              ibit27 * adv_mom_1              &
-                                      ) *                                      &
-                                     ( w(k,j,i)   + w(k,j,i-1) )               &
-                               -      (  8.0_wp * ibit29 * adv_mom_5              &
-                                   +              ibit28 * adv_mom_3              &
-                                      ) *                                      &
-                                     ( w(k,j,i+1) + w(k,j,i-2) )               &
-                               +      (           ibit29 * adv_mom_5              &
-                                      ) *                                      &
-                                     ( w(k,j,i+2) + w(k,j,i-3) )               &
-                                                 )
-
-                diss_l                    = - ABS( u_comp_l ) * (              &
-                                        ( 10.0_wp * ibit29 * adv_mom_5            &
-                                     +     3.0_wp * ibit28 * adv_mom_3            &
-                                     +              ibit27 * adv_mom_1            &
-                                        ) *                                    &
-                                     ( w(k,j,i)   - w(k,j,i-1) )               &
-                                 -      (  5.0_wp * ibit29 * adv_mom_5            &
-                                     +              ibit28 * adv_mom_3            &
-                                        ) *                                    &
-                                     ( w(k,j,i+1) - w(k,j,i-2) )               &
-                                 +      (           ibit29 * adv_mom_5            &
-                                        ) *                                    &
-                                     ( w(k,j,i+2) - w(k,j,i-3) )               &
-                                                            )
-
-                ibit27 = IBITS(wall_flags_0(k,j,i),27,1)
-                ibit28 = IBITS(wall_flags_0(k,j,i),28,1)
-                ibit29 = IBITS(wall_flags_0(k,j,i),29,1)
-
-                u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
-                flux_r    = u_comp * (                                       &
-                          ( 37.0_wp * ibit29 * adv_mom_5                        &
-                       +     7.0_wp * ibit28 * adv_mom_3                        &
-                       +              ibit27 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( w(k,j,i+1) + w(k,j,i)   )                 &
-                   -      (  8.0_wp * ibit29 * adv_mom_5                        &
-                       +              ibit28 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( w(k,j,i+2) + w(k,j,i-1) )                 &
-                   +      (           ibit29 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( w(k,j,i+3) + w(k,j,i-2) )                 &
-                                     )
-
-                diss_r    = - ABS( u_comp ) * (                              &
-                          ( 10.0_wp * ibit29 * adv_mom_5                        &
-                       +     3.0_wp * ibit28 * adv_mom_3                        &
-                       +              ibit27 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( w(k,j,i+1) - w(k,j,i)  )                  &
-                   -      (  5.0_wp * ibit29 * adv_mom_5                        &
-                       +              ibit28 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( w(k,j,i+2) - w(k,j,i-1) )                 &
-                   +      (           ibit29 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( w(k,j,i+3) - w(k,j,i-2) )                 &
-                                              )
-                ibit32 = IBITS(wall_flags_00(k,j-1,i),0,1)
-                ibit31 = IBITS(wall_flags_0(k,j-1,i),31,1)
-                ibit30 = IBITS(wall_flags_0(k,j-1,i),30,1)
-
-                v_comp_s               = v(k+1,j,i) + v(k,j,i) - gv
-                flux_s                 = v_comp_s * (                         &
-                                    ( 37.0_wp * ibit32 * adv_mom_5               &
-                                 +     7.0_wp * ibit31 * adv_mom_3               &
-                                 +              ibit30 * adv_mom_1               &
-                                    ) *                                       &
-                                     ( w(k,j,i)   + w(k,j-1,i) )              &
-                             -      (  8.0_wp * ibit32 * adv_mom_5               &
-                                 +              ibit31 * adv_mom_3               &
-                                    ) *                                       &
-                                     ( w(k,j+1,i) + w(k,j-2,i) )              &
-                             +      (           ibit32 * adv_mom_5               &
-                                    ) *                                       &
-                                     ( w(k,j+2,i) + w(k,j-3,i) )              &
-                                               )
-
-                diss_s                 = - ABS( v_comp_s ) * (                &
-                                    ( 10.0_wp * ibit32 * adv_mom_5               &
-                                 +     3.0_wp * ibit31 * adv_mom_3               &
-                                 +              ibit30 * adv_mom_1               &
-                                    ) *                                       &
-                                     ( w(k,j,i)   - w(k,j-1,i) )              &
-                             -      (  5.0_wp * ibit32 * adv_mom_5               &
-                                 +              ibit31 * adv_mom_3               &
-                                    ) *                                       &
-                                     ( w(k,j+1,i) - w(k,j-2,i) )              &
-                             +      (           ibit32 * adv_mom_5               &
-                                    ) *                                       &
-                                     ( w(k,j+2,i) - w(k,j-3,i) )              &
-                                                        )
-
-                ibit32 = IBITS(wall_flags_00(k,j,i),0,1)
-                ibit31 = IBITS(wall_flags_0(k,j,i),31,1)
-                ibit30 = IBITS(wall_flags_0(k,j,i),30,1)
-
-                v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
-                flux_n    = v_comp * (                                       &
-                          ( 37.0_wp * ibit32 * adv_mom_5                        &
-                       +     7.0_wp * ibit31 * adv_mom_3                        &
-                       +              ibit30 * adv_mom_1                        &
-                          ) *                                                 &
-                                 ( w(k,j+1,i) + w(k,j,i)   )                 &
-                   -      (  8.0_wp * ibit32 * adv_mom_5                        &
-                       +              ibit31 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( w(k,j+2,i) + w(k,j-1,i) )                 &
-                   +      (           ibit32 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( w(k,j+3,i) + w(k,j-2,i) )                 &
-                                     )
-
-                diss_n    = - ABS( v_comp ) * (                              &
-                          ( 10.0_wp * ibit32 * adv_mom_5                        &
-                       +     3.0_wp * ibit31 * adv_mom_3                        &
-                       +              ibit30 * adv_mom_1                        &
-                          ) *                                                &
-                                 ( w(k,j+1,i) - w(k,j,i)  )                  &
-                   -      (  5.0_wp * ibit32 * adv_mom_5                        &
-                       +              ibit31 * adv_mom_3                        &
-                          ) *                                                &
-                                 ( w(k,j+2,i) - w(k,j-1,i) )                 &
-                   +      (           ibit32 * adv_mom_5                        &
-                          ) *                                                &
-                                 ( w(k,j+3,i) - w(k,j-2,i) )                 &
-                                              )
-
-                ibit35 = IBITS(wall_flags_00(k-1,j,i),3,1)
-                ibit34 = IBITS(wall_flags_00(k-1,j,i),2,1)
-                ibit33 = IBITS(wall_flags_00(k-1,j,i),1,1)
-
-                k_pp  = k + 2 * ibit35
-                k_mm  = k - 2 * ( ibit34 + ibit35 )
-                k_mmm = k - 3 * ibit35
-
-                w_comp    = w(k,j,i) + w(k-1,j,i)
-                flux_d    = w_comp  * (                                      &
-                          ( 37.0_wp * ibit35 * adv_mom_5                        &
-                       +     7.0_wp * ibit34 * adv_mom_3                        &
-                       +              ibit33 * adv_mom_1                        &
-                          ) *                                                &
-                             ( w(k,j,i)    + w(k-1,j,i)   )                  &
-                   -      (  8.0_wp * ibit35 * adv_mom_5                        &
-                       +              ibit34 * adv_mom_3                        &
-                          ) *                                                &
-                             ( w(k+1,j,i)  + w(k_mm,j,i)  )                  &
-                   +      (           ibit35 * adv_mom_5                        &
-                          ) *                                                &
-                             ( w(k_pp,j,i) + w(k_mmm,j,i) )                  &
-                                       )
-
-                diss_d    = - ABS( w_comp ) * (                              &
-                          ( 10.0_wp * ibit35 * adv_mom_5                        &
-                       +     3.0_wp * ibit34 * adv_mom_3                        &
-                       +              ibit33 * adv_mom_1                        &
-                          ) *                                                &
-                             ( w(k,j,i)    - w(k-1,j,i)   )                  &
-                   -      (  5.0_wp * ibit35 * adv_mom_5                        &
-                       +              ibit34 * adv_mom_3                        &
-                          ) *                                                &
-                             ( w(k+1,j,i)  - w(k_mm,j,i)  )                  &
-                   +      (           ibit35 * adv_mom_5                        &
-                          ) *                                                &
-                             ( w(k_pp,j,i) - w(k_mmm,j,i) )                  &
-                                               )
-
-!
-!--             k index has to be modified near bottom and top, else array
-!--             subscripts will be exceeded.
-                ibit35 = IBITS(wall_flags_00(k,j,i),3,1)
-                ibit34 = IBITS(wall_flags_00(k,j,i),2,1)
-                ibit33 = IBITS(wall_flags_00(k,j,i),1,1)
-
-                k_ppp = k + 3 * ibit35
-                k_pp  = k + 2 * ( 1 - ibit33  )
-                k_mm  = k - 2 * ibit35
-
-                w_comp    = w(k+1,j,i) + w(k,j,i)
-                flux_t    = w_comp  * (                                      &
-                          ( 37.0_wp * ibit35 * adv_mom_5                        &
-                       +     7.0_wp * ibit34 * adv_mom_3                        &
-                       +              ibit33 * adv_mom_1                        &
-                          ) *                                                &
-                             ( w(k+1,j,i)  + w(k,j,i)     )                  &
-                   -      (  8.0_wp * ibit35 * adv_mom_5                        &
-                       +              ibit34 * adv_mom_3                        &
-                          ) *                                                &
-                             ( w(k_pp,j,i)  + w(k-1,j,i)  )                  &
-                   +      (           ibit35 * adv_mom_5                        &
-                          ) *                                                &
-                             ( w(k_ppp,j,i) + w(k_mm,j,i) )                  &
-                                       )
-
-                diss_t    = - ABS( w_comp ) * (                              &
-                          ( 10.0_wp * ibit35 * adv_mom_5                        &
-                       +     3.0_wp * ibit34 * adv_mom_3                        &
-                       +              ibit33 * adv_mom_1                        &
-                          ) *                                                &
-                             ( w(k+1,j,i)   - w(k,j,i)    )                  &
-                   -      (  5.0_wp * ibit35 * adv_mom_5                        &
-                       +              ibit34 * adv_mom_3                        &
-                          ) *                                                &
-                             ( w(k_pp,j,i)  - w(k-1,j,i)  )                  &
-                   +      (           ibit35 * adv_mom_5                        &
-                          ) *                                                &
-                             ( w(k_ppp,j,i) - w(k_mm,j,i) )                  &
-                                               )
-!
-!--             Calculate the divergence of the velocity field. A respective
-!--             correction is needed to overcome numerical instabilities caused
-!--             by a not sufficient reduction of divergences near topography.
-                div = ( ( ( u_comp + gu ) * ( ibit27 + ibit28 + ibit29 )      &
-                  - ( u(k+1,j,i) + u(k,j,i)   )                               & 
-                                    * ( IBITS(wall_flags_0(k,j,i-1),27,1)     &
-                                      + IBITS(wall_flags_0(k,j,i-1),28,1)     &
-                                      + IBITS(wall_flags_0(k,j,i-1),29,1)     &
-                                      )                                       &
-                  ) * ddx                                                     &
-              +   ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 )            & 
-                  - ( v(k+1,j,i) + v(k,j,i)   )                               &
-                                    * ( IBITS(wall_flags_0(k,j-1,i),30,1)     &
-                                      + IBITS(wall_flags_0(k,j-1,i),31,1)     &
-                                      + IBITS(wall_flags_00(k,j-1,i),0,1)     &
-                                      )                                       &
-                  ) * ddy                                                     &
-              +   ( w_comp          * ( ibit33 + ibit34 + ibit35 )            &
-                - ( w(k,j,i)   + w(k-1,j,i)   )                               &
-                                    * ( IBITS(wall_flags_00(k-1,j,i),1,1)     &
-                                      + IBITS(wall_flags_00(k-1,j,i),2,1)     &
-                                      + IBITS(wall_flags_00(k-1,j,i),3,1)     &
-                                      )                                       & 
-                  ) * ddzu(k+1)   &
-                ) * 0.5_wp
-
-
-                tend(k,j,i) = - (                                                &
-                               ( flux_r + diss_r - flux_l - diss_l ) * ddx       &
-                             + ( flux_n + diss_n - flux_s - diss_s ) * ddy       &
-                             + ( flux_t + diss_t - flux_d - diss_d ) * ddzu(k+1) &
-                                 ) + div * w(k,j,i)
-
-
-!++
-!--             Statistical Evaluation of w'w'.
-!                sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                    &
-!                               + ( flux_t + diss_t )                    &
-!                               *   weight_substep(intermediate_timestep_count)
-
-             ENDDO
-          ENDDO
-       ENDDO
-       !$acc end kernels
-
-    END SUBROUTINE advec_w_ws_acc
-
- END MODULE advec_ws
Index: /palm/trunk/SOURCE/buoyancy.f90
===================================================================
--- /palm/trunk/SOURCE/buoyancy.f90	(revision 1873)
+++ /palm/trunk/SOURCE/buoyancy.f90	(revision 1873)
@@ -0,0 +1,398 @@
+!> @file buoyancy.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1374 2014-04-25 12:55:07Z raasch
+! missing variables added to ONLY list
+! 
+! 1365 2014-04-22 15:03:56Z boeske
+! Calculation of reference state in subroutine calc_mean_profile moved to
+! subroutine time_integration,
+! subroutine calc_mean_profile moved to new file calc_mean_profile.f90
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1257 2013-11-08 15:18:40Z raasch
+! vector length (32) removed from openacc clause
+!
+! 1241 2013-10-30 11:36:58Z heinze
+! Generalize calc_mean_profile for wider use: use additional steering 
+! character loc 
+!
+! 1179 2013-06-14 05:57:58Z raasch
+! steering of reference state revised (var_reference and pr removed from
+! parameter list), use_reference renamed use_single_reference_value
+!
+! 1171 2013-05-30 11:27:45Z raasch
+! openacc statements added to use_reference-case in accelerator version
+!
+! 1153 2013-05-10 14:33:08Z raasch
+! code adjustments of accelerator version required by PGI 12.3 / CUDA 5.0
+!
+! 1128 2013-04-12 06:19:32Z raasch
+! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
+! j_north
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1015 2012-09-27 09:23:24Z raasch
+! accelerator version (*_acc) added
+!
+! 1010 2012-09-20 07:59:54Z raasch
+! cpp switch __nopointer added for pointer free version
+!
+! Revision 1.1  1997/08/29 08:56:48  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Buoyancy term of the third component of the equation of motion.
+!> @attention Humidity is not regarded when using a sloping surface!
+!------------------------------------------------------------------------------!
+ MODULE buoyancy_mod
+ 
+
+    PRIVATE
+    PUBLIC buoyancy, buoyancy_acc
+
+    INTERFACE buoyancy
+       MODULE PROCEDURE buoyancy
+       MODULE PROCEDURE buoyancy_ij
+    END INTERFACE buoyancy
+
+    INTERFACE buoyancy_acc
+       MODULE PROCEDURE buoyancy_acc
+    END INTERFACE buoyancy_acc
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE buoyancy( var, wind_component )
+
+       USE arrays_3d,                                                          &
+           ONLY:  pt, pt_slope_ref, ref_state, tend
+
+       USE control_parameters,                                                 &
+           ONLY:  atmos_ocean_sign, cos_alpha_surface, g, message_string,      &
+                  pt_surface, sin_alpha_surface, sloping_surface
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nzb,       &
+                  nzb_s_inner, nzt
+
+       USE kinds
+
+       USE pegrid
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i              !<
+       INTEGER(iwp) ::  j              !<
+       INTEGER(iwp) ::  k              !<
+       INTEGER(iwp) ::  wind_component !<
+       
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
+#endif
+
+
+       IF ( .NOT. sloping_surface )  THEN
+!
+!--       Normal case: horizontal surface
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                DO  k = nzb_s_inner(j,i)+1, nzt-1
+                   tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5_wp * &
+                          (                                                    &
+                             ( var(k,j,i)   - ref_state(k) )   / ref_state(k) + &
+                             ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1) &
+                          )
+                ENDDO
+             ENDDO
+          ENDDO
+
+       ELSE
+!
+!--       Buoyancy term for a surface with a slope in x-direction. The equations
+!--       for both the u and w velocity-component contain proportionate terms.
+!--       Temperature field at time t=0 serves as environmental temperature.
+!--       Reference temperature (pt_surface) is the one at the lower left corner
+!--       of the total domain.
+          IF ( wind_component == 1 )  THEN
+
+             DO  i = nxlu, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
+                      tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *      &
+                           0.5_wp * ( ( pt(k,j,i-1)         + pt(k,j,i)         ) &
+                                    - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
+                                    ) / pt_surface
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          ELSEIF ( wind_component == 3 )  THEN
+
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
+                      tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *      &
+                           0.5_wp * ( ( pt(k,j,i)         + pt(k+1,j,i)         ) &
+                                    - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
+                                    ) / pt_surface
+                   ENDDO
+                ENDDO
+            ENDDO
+
+          ELSE
+             
+             WRITE( message_string, * ) 'no term for component "',             &
+                                       wind_component,'"'
+             CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 )
+
+          ENDIF
+
+       ENDIF
+
+    END SUBROUTINE buoyancy
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE buoyancy_acc( var, wind_component )
+
+       USE arrays_3d,                                                          &
+           ONLY:  pt, pt_slope_ref, ref_state, tend
+
+       USE control_parameters,                                                 &
+           ONLY:  atmos_ocean_sign, cos_alpha_surface, g, message_string,      &
+                  pt_surface, sin_alpha_surface, sloping_surface
+
+       USE indices,                                                            &
+           ONLY:  i_left, i_right, j_north, j_south, nxl, nxlg, nxlu, nxr,     &
+                  nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner, nzt
+
+       USE kinds
+
+       USE pegrid
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i              !<
+       INTEGER(iwp) ::  j              !<
+       INTEGER(iwp) ::  k              !<
+       INTEGER(iwp) ::  wind_component !<
+       
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
+#endif
+
+
+       IF ( .NOT. sloping_surface )  THEN
+!
+!--       Normal case: horizontal surface
+          !$acc kernels present( nzb_s_inner, ref_state, tend, var )
+          !$acc loop
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+                !$acc loop independent vector
+                DO  k = nzb_s_inner(j,i)+1, nzt-1
+                   tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5_wp * &
+                          (                                                    &
+                             ( var(k,j,i)   - ref_state(k) )   / ref_state(k) + &
+                             ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1) &
+                          )
+                ENDDO
+             ENDDO
+          ENDDO
+          !$acc end kernels
+
+       ELSE
+!
+!--       Buoyancy term for a surface with a slope in x-direction. The equations
+!--       for both the u and w velocity-component contain proportionate terms.
+!--       Temperature field at time t=0 serves as environmental temperature.
+!--       Reference temperature (pt_surface) is the one at the lower left corner
+!--       of the total domain.
+          IF ( wind_component == 1 )  THEN
+
+             DO  i = nxlu, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
+                      tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *      &
+                           0.5_wp * ( ( pt(k,j,i-1)         + pt(k,j,i)         ) &
+                                    - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
+                                    ) / pt_surface
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          ELSEIF ( wind_component == 3 )  THEN
+
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt-1
+                      tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *      &
+                           0.5_wp * ( ( pt(k,j,i)         + pt(k+1,j,i)         ) &
+                                    - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
+                                    ) / pt_surface
+                   ENDDO
+                ENDDO
+            ENDDO
+
+          ELSE
+
+             WRITE( message_string, * ) 'no term for component "',             &
+                                       wind_component,'"'
+             CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 )
+
+          ENDIF
+
+       ENDIF
+
+    END SUBROUTINE buoyancy_acc
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!> @attention PGI-compiler creates SIGFPE if opt>1 is used! Therefore, opt=1 is
+!>            forced by compiler-directive.
+!------------------------------------------------------------------------------!
+!pgi$r opt=1
+    SUBROUTINE buoyancy_ij( i, j, var, wind_component )
+
+       USE arrays_3d,                                                          &
+           ONLY:  pt, pt_slope_ref, ref_state, tend
+
+       USE control_parameters,                                                 &
+           ONLY:  atmos_ocean_sign, cos_alpha_surface, g, message_string,      &
+                  pt_surface, sin_alpha_surface, sloping_surface
+
+       USE indices,                                                            &
+           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
+
+       USE kinds
+
+       USE pegrid
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i              !<
+       INTEGER(iwp) ::  j              !<
+       INTEGER(iwp) ::  k              !<
+       INTEGER(iwp) ::  pr             !<
+       INTEGER(iwp) ::  wind_component !<
+       
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
+#endif
+
+
+       IF ( .NOT. sloping_surface )  THEN
+!
+!--       Normal case: horizontal surface
+          DO  k = nzb_s_inner(j,i)+1, nzt-1
+              tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5_wp * (    &
+                        ( var(k,j,i)   - ref_state(k)   ) / ref_state(k)   +   &
+                        ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1)     &
+                                                                          )
+          ENDDO
+
+       ELSE
+!
+!--       Buoyancy term for a surface with a slope in x-direction. The equations
+!--       for both the u and w velocity-component contain proportionate terms.
+!--       Temperature field at time t=0 serves as environmental temperature.
+!--       Reference temperature (pt_surface) is the one at the lower left corner
+!--       of the total domain.
+          IF ( wind_component == 1 )  THEN
+
+             DO  k = nzb_s_inner(j,i)+1, nzt-1
+                tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *            &
+                           0.5_wp * ( ( pt(k,j,i-1)         + pt(k,j,i)         ) &
+                                    - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
+                                    ) / pt_surface
+             ENDDO
+
+          ELSEIF ( wind_component == 3 )  THEN
+
+             DO  k = nzb_s_inner(j,i)+1, nzt-1
+                tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *            &
+                           0.5_wp * ( ( pt(k,j,i)         + pt(k+1,j,i)         ) &
+                                    - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
+                                    ) / pt_surface
+             ENDDO
+
+          ELSE
+
+             WRITE( message_string, * ) 'no term for component "',             &
+                                       wind_component,'"'
+             CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 )
+
+          ENDIF
+
+       ENDIF
+
+    END SUBROUTINE buoyancy_ij
+
+ END MODULE buoyancy_mod
Index: lm/trunk/SOURCE/buoyancy_mod.f90
===================================================================
--- /palm/trunk/SOURCE/buoyancy_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,397 +1,0 @@
-!> @file buoyancy_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1374 2014-04-25 12:55:07Z raasch
-! missing variables added to ONLY list
-! 
-! 1365 2014-04-22 15:03:56Z boeske
-! Calculation of reference state in subroutine calc_mean_profile moved to
-! subroutine time_integration,
-! subroutine calc_mean_profile moved to new file calc_mean_profile.f90
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1257 2013-11-08 15:18:40Z raasch
-! vector length (32) removed from openacc clause
-!
-! 1241 2013-10-30 11:36:58Z heinze
-! Generalize calc_mean_profile for wider use: use additional steering 
-! character loc 
-!
-! 1179 2013-06-14 05:57:58Z raasch
-! steering of reference state revised (var_reference and pr removed from
-! parameter list), use_reference renamed use_single_reference_value
-!
-! 1171 2013-05-30 11:27:45Z raasch
-! openacc statements added to use_reference-case in accelerator version
-!
-! 1153 2013-05-10 14:33:08Z raasch
-! code adjustments of accelerator version required by PGI 12.3 / CUDA 5.0
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! accelerator version (*_acc) added
-!
-! 1010 2012-09-20 07:59:54Z raasch
-! cpp switch __nopointer added for pointer free version
-!
-! Revision 1.1  1997/08/29 08:56:48  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Buoyancy term of the third component of the equation of motion.
-!> @attention Humidity is not regarded when using a sloping surface!
-!------------------------------------------------------------------------------!
- MODULE buoyancy_mod
- 
-
-    PRIVATE
-    PUBLIC buoyancy, buoyancy_acc
-
-    INTERFACE buoyancy
-       MODULE PROCEDURE buoyancy
-       MODULE PROCEDURE buoyancy_ij
-    END INTERFACE buoyancy
-
-    INTERFACE buoyancy_acc
-       MODULE PROCEDURE buoyancy_acc
-    END INTERFACE buoyancy_acc
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE buoyancy( var, wind_component )
-
-       USE arrays_3d,                                                          &
-           ONLY:  pt, pt_slope_ref, ref_state, tend
-
-       USE control_parameters,                                                 &
-           ONLY:  atmos_ocean_sign, cos_alpha_surface, g, message_string,      &
-                  pt_surface, sin_alpha_surface, sloping_surface
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nzb,       &
-                  nzb_s_inner, nzt
-
-       USE kinds
-
-       USE pegrid
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i              !<
-       INTEGER(iwp) ::  j              !<
-       INTEGER(iwp) ::  k              !<
-       INTEGER(iwp) ::  wind_component !<
-       
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
-#endif
-
-
-       IF ( .NOT. sloping_surface )  THEN
-!
-!--       Normal case: horizontal surface
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb_s_inner(j,i)+1, nzt-1
-                   tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5_wp * &
-                          (                                                    &
-                             ( var(k,j,i)   - ref_state(k) )   / ref_state(k) + &
-                             ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1) &
-                          )
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ELSE
-!
-!--       Buoyancy term for a surface with a slope in x-direction. The equations
-!--       for both the u and w velocity-component contain proportionate terms.
-!--       Temperature field at time t=0 serves as environmental temperature.
-!--       Reference temperature (pt_surface) is the one at the lower left corner
-!--       of the total domain.
-          IF ( wind_component == 1 )  THEN
-
-             DO  i = nxlu, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt-1
-                      tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *      &
-                           0.5_wp * ( ( pt(k,j,i-1)         + pt(k,j,i)         ) &
-                                    - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
-                                    ) / pt_surface
-                   ENDDO
-                ENDDO
-             ENDDO
-
-          ELSEIF ( wind_component == 3 )  THEN
-
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt-1
-                      tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *      &
-                           0.5_wp * ( ( pt(k,j,i)         + pt(k+1,j,i)         ) &
-                                    - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
-                                    ) / pt_surface
-                   ENDDO
-                ENDDO
-            ENDDO
-
-          ELSE
-             
-             WRITE( message_string, * ) 'no term for component "',             &
-                                       wind_component,'"'
-             CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 )
-
-          ENDIF
-
-       ENDIF
-
-    END SUBROUTINE buoyancy
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE buoyancy_acc( var, wind_component )
-
-       USE arrays_3d,                                                          &
-           ONLY:  pt, pt_slope_ref, ref_state, tend
-
-       USE control_parameters,                                                 &
-           ONLY:  atmos_ocean_sign, cos_alpha_surface, g, message_string,      &
-                  pt_surface, sin_alpha_surface, sloping_surface
-
-       USE indices,                                                            &
-           ONLY:  i_left, i_right, j_north, j_south, nxl, nxlg, nxlu, nxr,     &
-                  nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner, nzt
-
-       USE kinds
-
-       USE pegrid
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i              !<
-       INTEGER(iwp) ::  j              !<
-       INTEGER(iwp) ::  k              !<
-       INTEGER(iwp) ::  wind_component !<
-       
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
-#endif
-
-
-       IF ( .NOT. sloping_surface )  THEN
-!
-!--       Normal case: horizontal surface
-          !$acc kernels present( nzb_s_inner, ref_state, tend, var )
-          !$acc loop
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-                !$acc loop independent vector
-                DO  k = nzb_s_inner(j,i)+1, nzt-1
-                   tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5_wp * &
-                          (                                                    &
-                             ( var(k,j,i)   - ref_state(k) )   / ref_state(k) + &
-                             ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1) &
-                          )
-                ENDDO
-             ENDDO
-          ENDDO
-          !$acc end kernels
-
-       ELSE
-!
-!--       Buoyancy term for a surface with a slope in x-direction. The equations
-!--       for both the u and w velocity-component contain proportionate terms.
-!--       Temperature field at time t=0 serves as environmental temperature.
-!--       Reference temperature (pt_surface) is the one at the lower left corner
-!--       of the total domain.
-          IF ( wind_component == 1 )  THEN
-
-             DO  i = nxlu, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt-1
-                      tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *      &
-                           0.5_wp * ( ( pt(k,j,i-1)         + pt(k,j,i)         ) &
-                                    - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
-                                    ) / pt_surface
-                   ENDDO
-                ENDDO
-             ENDDO
-
-          ELSEIF ( wind_component == 3 )  THEN
-
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt-1
-                      tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *      &
-                           0.5_wp * ( ( pt(k,j,i)         + pt(k+1,j,i)         ) &
-                                    - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
-                                    ) / pt_surface
-                   ENDDO
-                ENDDO
-            ENDDO
-
-          ELSE
-
-             WRITE( message_string, * ) 'no term for component "',             &
-                                       wind_component,'"'
-             CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 )
-
-          ENDIF
-
-       ENDIF
-
-    END SUBROUTINE buoyancy_acc
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!> @attention PGI-compiler creates SIGFPE if opt>1 is used! Therefore, opt=1 is
-!>            forced by compiler-directive.
-!------------------------------------------------------------------------------!
-!pgi$r opt=1
-    SUBROUTINE buoyancy_ij( i, j, var, wind_component )
-
-       USE arrays_3d,                                                          &
-           ONLY:  pt, pt_slope_ref, ref_state, tend
-
-       USE control_parameters,                                                 &
-           ONLY:  atmos_ocean_sign, cos_alpha_surface, g, message_string,      &
-                  pt_surface, sin_alpha_surface, sloping_surface
-
-       USE indices,                                                            &
-           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
-
-       USE kinds
-
-       USE pegrid
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i              !<
-       INTEGER(iwp) ::  j              !<
-       INTEGER(iwp) ::  k              !<
-       INTEGER(iwp) ::  pr             !<
-       INTEGER(iwp) ::  wind_component !<
-       
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
-#endif
-
-
-       IF ( .NOT. sloping_surface )  THEN
-!
-!--       Normal case: horizontal surface
-          DO  k = nzb_s_inner(j,i)+1, nzt-1
-              tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5_wp * (    &
-                        ( var(k,j,i)   - ref_state(k)   ) / ref_state(k)   +   &
-                        ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1)     &
-                                                                          )
-          ENDDO
-
-       ELSE
-!
-!--       Buoyancy term for a surface with a slope in x-direction. The equations
-!--       for both the u and w velocity-component contain proportionate terms.
-!--       Temperature field at time t=0 serves as environmental temperature.
-!--       Reference temperature (pt_surface) is the one at the lower left corner
-!--       of the total domain.
-          IF ( wind_component == 1 )  THEN
-
-             DO  k = nzb_s_inner(j,i)+1, nzt-1
-                tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *            &
-                           0.5_wp * ( ( pt(k,j,i-1)         + pt(k,j,i)         ) &
-                                    - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
-                                    ) / pt_surface
-             ENDDO
-
-          ELSEIF ( wind_component == 3 )  THEN
-
-             DO  k = nzb_s_inner(j,i)+1, nzt-1
-                tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *            &
-                           0.5_wp * ( ( pt(k,j,i)         + pt(k+1,j,i)         ) &
-                                    - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
-                                    ) / pt_surface
-             ENDDO
-
-          ELSE
-
-             WRITE( message_string, * ) 'no term for component "',             &
-                                       wind_component,'"'
-             CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 )
-
-          ENDIF
-
-       ENDIF
-
-    END SUBROUTINE buoyancy_ij
-
- END MODULE buoyancy_mod
Index: /palm/trunk/SOURCE/calc_mean_profile.f90
===================================================================
--- /palm/trunk/SOURCE/calc_mean_profile.f90	(revision 1873)
+++ /palm/trunk/SOURCE/calc_mean_profile.f90	(revision 1873)
@@ -0,0 +1,147 @@
+!> @file calc_mean_profile.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+!
+! 1738 2015-12-18 13:56:05Z raasch
+! bugfix: if a layer is completely filled with topography, no mean is calculated
+!
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1365 2014-04-22 15:03:56Z boeske
+! Initial revision
+!
+! Description:
+! ------------
+!> Calculate the horizontally averaged vertical temperature profile (pr=4 in case
+!> of potential temperature, 44 in case of virtual potential temperature, and 64
+!> in case of density (ocean runs)).
+!------------------------------------------------------------------------------!
+ MODULE calc_mean_profile_mod
+ 
+
+    PRIVATE
+    PUBLIC calc_mean_profile
+
+    INTERFACE calc_mean_profile
+       MODULE PROCEDURE calc_mean_profile
+    END INTERFACE calc_mean_profile
+
+ CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> @todo Missing subroutine description.
+!------------------------------------------------------------------------------!
+    SUBROUTINE calc_mean_profile( var, pr )
+
+       USE control_parameters,                                                 &
+           ONLY:  intermediate_timestep_count, message_string
+
+       USE indices,                                                            &
+           ONLY:  ngp_2dh_s_inner, nxl, nxr, nyn, nys, nzb, nzb_s_inner, nzt
+
+       USE kinds
+
+       USE pegrid
+
+       USE statistics,                                                         &
+           ONLY:  flow_statistics_called, hom, sums, sums_l
+
+
+       IMPLICIT NONE
+       
+       INTEGER(iwp) ::  i                  !<
+       INTEGER(iwp) ::  j                  !<
+       INTEGER(iwp) ::  k                  !<
+       INTEGER(iwp) ::  pr                 !< 
+       INTEGER(iwp) ::  omp_get_thread_num !<
+       INTEGER(iwp) ::  tn                 !<
+       
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(:,:,:) ::  var  !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
+#endif
+
+!
+!--    Computation of the horizontally averaged profile of variable var, unless
+!--    already done by the relevant call from flow_statistics. The calculation
+!--    is done only for the first respective intermediate timestep in order to
+!--    spare communication time and to produce identical model results with jobs
+!--    which are calling flow_statistics at different time intervals.
+       IF ( .NOT. flow_statistics_called  .AND.                                &
+            intermediate_timestep_count == 1 )  THEN
+
+!
+!--       Horizontal average of variable var
+          tn           =   0  ! Default thread number in case of one thread
+          !$OMP PARALLEL PRIVATE( i, j, k, tn )
+!$        tn = omp_get_thread_num()
+          sums_l(:,pr,tn) = 0.0_wp
+          !$OMP DO
+          DO  i = nxl, nxr
+             DO  j =  nys, nyn
+                DO  k = nzb_s_inner(j,i), nzt+1
+                   sums_l(k,pr,tn) = sums_l(k,pr,tn) + var(k,j,i)
+                ENDDO
+             ENDDO
+          ENDDO
+          !$OMP END PARALLEL
+
+          DO  i = 1, threads_per_task-1
+             sums_l(:,pr,0) = sums_l(:,pr,0) + sums_l(:,pr,i)
+          ENDDO
+
+#if defined( __parallel )
+
+          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
+          CALL MPI_ALLREDUCE( sums_l(nzb,pr,0), sums(nzb,pr), nzt+2-nzb,       &
+                              MPI_REAL, MPI_SUM, comm2d, ierr )
+
+#else
+
+          sums(:,pr) = sums_l(:,pr,0)
+
+#endif
+
+          DO  k = nzb, nzt+1
+             IF ( ngp_2dh_s_inner(k,0) /= 0 )  THEN
+                hom(k,1,pr,0) = sums(k,pr) / ngp_2dh_s_inner(k,0)
+             ENDIF
+          ENDDO
+
+       ENDIF
+
+
+    END SUBROUTINE calc_mean_profile
+
+ END MODULE calc_mean_profile_mod
Index: lm/trunk/SOURCE/calc_mean_profile_mod.f90
===================================================================
--- /palm/trunk/SOURCE/calc_mean_profile_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,146 +1,0 @@
-!> @file calc_mean_profile_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-!
-! 1738 2015-12-18 13:56:05Z raasch
-! bugfix: if a layer is completely filled with topography, no mean is calculated
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1365 2014-04-22 15:03:56Z boeske
-! Initial revision
-!
-! Description:
-! ------------
-!> Calculate the horizontally averaged vertical temperature profile (pr=4 in case
-!> of potential temperature, 44 in case of virtual potential temperature, and 64
-!> in case of density (ocean runs)).
-!------------------------------------------------------------------------------!
- MODULE calc_mean_profile_mod
- 
-
-    PRIVATE
-    PUBLIC calc_mean_profile
-
-    INTERFACE calc_mean_profile
-       MODULE PROCEDURE calc_mean_profile
-    END INTERFACE calc_mean_profile
-
- CONTAINS
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!------------------------------------------------------------------------------!
-    SUBROUTINE calc_mean_profile( var, pr )
-
-       USE control_parameters,                                                 &
-           ONLY:  intermediate_timestep_count, message_string
-
-       USE indices,                                                            &
-           ONLY:  ngp_2dh_s_inner, nxl, nxr, nyn, nys, nzb, nzb_s_inner, nzt
-
-       USE kinds
-
-       USE pegrid
-
-       USE statistics,                                                         &
-           ONLY:  flow_statistics_called, hom, sums, sums_l
-
-
-       IMPLICIT NONE
-       
-       INTEGER(iwp) ::  i                  !<
-       INTEGER(iwp) ::  j                  !<
-       INTEGER(iwp) ::  k                  !<
-       INTEGER(iwp) ::  pr                 !< 
-       INTEGER(iwp) ::  omp_get_thread_num !<
-       INTEGER(iwp) ::  tn                 !<
-       
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(:,:,:) ::  var  !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
-#endif
-
-!
-!--    Computation of the horizontally averaged profile of variable var, unless
-!--    already done by the relevant call from flow_statistics. The calculation
-!--    is done only for the first respective intermediate timestep in order to
-!--    spare communication time and to produce identical model results with jobs
-!--    which are calling flow_statistics at different time intervals.
-       IF ( .NOT. flow_statistics_called  .AND.                                &
-            intermediate_timestep_count == 1 )  THEN
-
-!
-!--       Horizontal average of variable var
-          tn           =   0  ! Default thread number in case of one thread
-          !$OMP PARALLEL PRIVATE( i, j, k, tn )
-!$        tn = omp_get_thread_num()
-          sums_l(:,pr,tn) = 0.0_wp
-          !$OMP DO
-          DO  i = nxl, nxr
-             DO  j =  nys, nyn
-                DO  k = nzb_s_inner(j,i), nzt+1
-                   sums_l(k,pr,tn) = sums_l(k,pr,tn) + var(k,j,i)
-                ENDDO
-             ENDDO
-          ENDDO
-          !$OMP END PARALLEL
-
-          DO  i = 1, threads_per_task-1
-             sums_l(:,pr,0) = sums_l(:,pr,0) + sums_l(:,pr,i)
-          ENDDO
-
-#if defined( __parallel )
-
-          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_ALLREDUCE( sums_l(nzb,pr,0), sums(nzb,pr), nzt+2-nzb,       &
-                              MPI_REAL, MPI_SUM, comm2d, ierr )
-
-#else
-
-          sums(:,pr) = sums_l(:,pr,0)
-
-#endif
-
-          DO  k = nzb, nzt+1
-             IF ( ngp_2dh_s_inner(k,0) /= 0 )  THEN
-                hom(k,1,pr,0) = sums(k,pr) / ngp_2dh_s_inner(k,0)
-             ENDIF
-          ENDDO
-
-       ENDIF
-
-
-    END SUBROUTINE calc_mean_profile
-
- END MODULE calc_mean_profile_mod
Index: /palm/trunk/SOURCE/calc_radiation.f90
===================================================================
--- /palm/trunk/SOURCE/calc_radiation.f90	(revision 1873)
+++ /palm/trunk/SOURCE/calc_radiation.f90	(revision 1873)
@@ -0,0 +1,359 @@
+!> @file calc_radiation.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1322 2014-03-20 16:38:49Z raasch
+! exponent 4.0 changed to integer
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! Revision 1.1  2000/04/13 14:42:45  schroeter
+! Initial revision
+!
+!
+! Description:
+! -------------
+!> Calculation of the vertical divergences of the long-wave radiation-fluxes
+!> based on the parameterization of the cloud effective emissivity
+!------------------------------------------------------------------------------!
+ MODULE calc_radiation_mod
+ 
+    USE kinds
+    
+    PRIVATE
+    PUBLIC calc_radiation
+    
+    LOGICAL, SAVE ::  first_call = .TRUE. !<
+    REAL(wp), SAVE ::  sigma = 5.67E-08_wp   !<
+
+    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  lwp_ground         !<
+    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  lwp_top            !<
+    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  blackbody_emission !<
+
+    INTERFACE calc_radiation
+       MODULE PROCEDURE calc_radiation
+       MODULE PROCEDURE calc_radiation_ij
+    END INTERFACE calc_radiation
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE calc_radiation
+
+       USE arrays_3d,                                                          &
+           ONLY:  dzw, pt, ql, tend
+
+       USE cloud_parameters,                                                   &
+           ONLY:  cp, l_d_cp, pt_d_t, t_d_pt
+
+       USE control_parameters,                                                 &
+           ONLY:  rho_surface
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_s_inner, nzt
+
+       USE kinds
+
+       USE pegrid
+
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  k      !<
+       INTEGER(iwp) ::  k_help !<
+ 
+       REAL(wp) :: df_p                      !<
+       REAL(wp) :: df_m                      !<
+       REAL(wp) :: effective_emission_up_m   !<
+       REAL(wp) :: effective_emission_up_p   !<
+       REAL(wp) :: effective_emission_down_m !<
+       REAL(wp) :: effective_emission_down_p !<
+       REAL(wp) :: f_up_m                    !<
+       REAL(wp) :: f_up_p                    !<
+       REAL(wp) :: f_down_m                  !<
+       REAL(wp) :: f_down_p                  !<
+       REAL(wp) :: impinging_flux_at_top     !<
+       REAL(wp) :: temperature               !<
+
+
+!
+!--    On first call, allocate temporary arrays
+       IF ( first_call )  THEN
+          ALLOCATE( blackbody_emission(nzb:nzt+1), lwp_ground(nzb:nzt+1),      &
+                    lwp_top(nzb:nzt+1) )
+          first_call = .FALSE.
+       ENDIF
+
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+!
+!--          Compute the liquid water path (LWP) and blackbody_emission
+!--          at all vertical levels
+             lwp_ground(nzb) = 0.0_wp
+             lwp_top(nzt+1)  = rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
+
+             temperature     = pt(nzb,j,i) * t_d_pt(nzb) + l_d_cp * ql(nzb,j,i)
+             blackbody_emission(nzb) = sigma * temperature**4
+
+             DO  k = nzb_s_inner(j,i)+1, nzt
+
+                k_help = ( nzt+nzb+1 ) - k
+                lwp_ground(k)   = lwp_ground(k-1) + rho_surface * ql(k,j,i) *  &
+                                  dzw(k)
+
+                lwp_top(k_help) = lwp_top(k_help+1) +                          &
+                                  rho_surface * ql(k_help,j,i) * dzw(k_help)
+
+                temperature     = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i)
+                blackbody_emission(k) = sigma * temperature**4
+
+             ENDDO
+
+             lwp_ground(nzt+1) = lwp_ground(nzt) +                             &
+                                 rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
+             lwp_top(nzb)      = lwp_top(nzb+1)
+
+             temperature       = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp *      &
+                                 ql(nzt+1,j,i)
+             blackbody_emission(nzt+1) = sigma * temperature**4
+
+!
+!--          See Chlond '92, this is just a first guess
+             impinging_flux_at_top = blackbody_emission(nzb) - 100.0_wp
+
+             DO  k = nzb_s_inner(j,i)+1, nzt
+!
+!--             Save some computational time, but this may cause load
+!--             imbalances if ql is not distributed uniformly
+                IF ( ql(k,j,i) /= 0.0_wp ) THEN
+!
+!--                Compute effective emissivities
+                   effective_emission_up_p   = 1.0_wp -                        &
+                                               EXP( -130.0_wp * lwp_ground(k+1) )
+                   effective_emission_up_m   = 1.0_wp -                        &
+                                               EXP( -130.0_wp * lwp_ground(k-1) )
+                   effective_emission_down_p = 1.0_wp -                        &
+                                               EXP( -158.0_wp * lwp_top(k+1) )
+                   effective_emission_down_m = 1.0_wp -                        &
+                                               EXP( -158.0_wp * lwp_top(k-1) )  
+
+!
+!--                Compute vertical long wave radiation fluxes
+                   f_up_p = blackbody_emission(nzb) +                          &
+                            effective_emission_up_p *                          &
+                           ( blackbody_emission(k) - blackbody_emission(nzb) )
+
+                   f_up_m = blackbody_emission(nzb) +                          &
+                            effective_emission_up_m *                          &
+                           ( blackbody_emission(k-1) - blackbody_emission(nzb) )
+
+                   f_down_p = impinging_flux_at_top +                          &
+                              effective_emission_down_p *                      &
+                             ( blackbody_emission(k) - impinging_flux_at_top )
+
+                   f_down_m = impinging_flux_at_top +                          &
+                              effective_emission_down_m *                      &
+                             ( blackbody_emission(k-1) - impinging_flux_at_top )
+
+!
+!--                Divergence of vertical long wave radiation fluxes
+                   df_p = f_up_p - f_down_p
+                   df_m = f_up_m - f_down_m
+
+!
+!--                Compute tendency term         
+                   tend(k,j,i) = tend(k,j,i) -                                 &
+                                ( pt_d_t(k) / ( rho_surface * cp ) *           &
+                                  ( df_p - df_m ) / dzw(k) )
+
+                ENDIF
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE calc_radiation
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE calc_radiation_ij( i, j )
+
+       USE arrays_3d,                                                          &
+           ONLY:  dzw, pt, ql, tend
+
+       USE cloud_parameters,                                                   &
+           ONLY:  cp, l_d_cp, pt_d_t, t_d_pt
+
+       USE control_parameters,                                                 &
+           ONLY:  rho_surface
+
+       USE indices,                                                            &
+           ONLY:  nzb, nzb_s_inner, nzt
+
+       USE kinds
+
+       USE pegrid
+
+   
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  k      !<
+       INTEGER(iwp) ::  k_help !<
+
+       REAL(wp) :: df_p                      !<
+       REAL(wp) :: df_m                      !<
+       REAL(wp) :: effective_emission_up_m   !<
+       REAL(wp) :: effective_emission_up_p   !<
+       REAL(wp) :: effective_emission_down_m !<
+       REAL(wp) :: effective_emission_down_p !<
+       REAL(wp) :: f_up_m                    !<
+       REAL(wp) :: f_up_p                    !<
+       REAL(wp) :: f_down_m                  !<
+       REAL(wp) :: f_down_p                  !<
+       REAL(wp) :: impinging_flux_at_top     !<
+       REAL(wp) :: temperature               !<
+
+       
+!
+!--    On first call, allocate temporary arrays
+       IF ( first_call )  THEN
+          ALLOCATE( blackbody_emission(nzb:nzt+1), lwp_ground(nzb:nzt+1),      &
+                    lwp_top(nzb:nzt+1) )
+          first_call = .FALSE.
+       ENDIF
+
+!
+!--    Compute the liquid water path (LWP) and blackbody_emission
+!--    at all vertical levels
+       lwp_ground(nzb) = 0.0_wp
+       lwp_top(nzt+1)  = rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
+
+       temperature     = pt(nzb,j,i) * t_d_pt(nzb) + l_d_cp * ql(nzb,j,i)
+       blackbody_emission(nzb) = sigma * temperature**4
+
+       DO  k = nzb_s_inner(j,i)+1, nzt
+          k_help = ( nzt+nzb+1 ) - k
+          lwp_ground(k)   = lwp_ground(k-1) + rho_surface * ql(k,j,i) * dzw(k)
+
+          lwp_top(k_help) = lwp_top(k_help+1) +                                &
+                            rho_surface * ql(k_help,j,i) * dzw(k_help)
+
+          temperature     = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i)
+          blackbody_emission(k) = sigma * temperature**4
+
+       ENDDO
+       lwp_ground(nzt+1) = lwp_ground(nzt) +                                   &
+                           rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
+       lwp_top(nzb)      = lwp_top(nzb+1)
+
+       temperature       = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp *            &
+                           ql(nzt+1,j,i)
+       blackbody_emission(nzt+1) = sigma * temperature**4
+
+!
+!--    See Chlond '92, this is just a first guess
+       impinging_flux_at_top = blackbody_emission(nzb) - 100.0_wp
+
+       DO  k = nzb_s_inner(j,i)+1, nzt
+!
+!--       Store some computational time,
+!--       this may cause load imbalances if ql is not distributed uniformly
+          IF ( ql(k,j,i) /= 0.0_wp ) THEN
+!
+!--          Compute effective emissivities
+             effective_emission_up_p   = 1.0_wp -                              &
+                                         EXP( -130.0_wp * lwp_ground(k+1) )
+             effective_emission_up_m   = 1.0_wp -                              &
+                                         EXP( -130.0_wp * lwp_ground(k-1) )
+             effective_emission_down_p = 1.0_wp -                              &
+                                         EXP( -158.0_wp * lwp_top(k+1) )
+             effective_emission_down_m = 1.0_wp -                              &
+                                         EXP( -158.0_wp * lwp_top(k-1) )  
+             
+!
+!--          Compute vertical long wave radiation fluxes
+             f_up_p = blackbody_emission(nzb) + effective_emission_up_p *      &
+                     ( blackbody_emission(k) - blackbody_emission(nzb) )
+
+             f_up_m = blackbody_emission(nzb) + effective_emission_up_m *      &
+                     ( blackbody_emission(k-1) - blackbody_emission(nzb) )
+
+             f_down_p = impinging_flux_at_top + effective_emission_down_p *    &
+                       ( blackbody_emission(k) - impinging_flux_at_top )
+
+             f_down_m = impinging_flux_at_top + effective_emission_down_m *    &
+                       ( blackbody_emission(k-1) - impinging_flux_at_top )
+
+!
+!-           Divergence of vertical long wave radiation fluxes
+             df_p = f_up_p - f_down_p
+             df_m = f_up_m - f_down_m
+
+!
+!--          Compute tendency term         
+             tend(k,j,i) = tend(k,j,i) - ( pt_d_t(k) / ( rho_surface * cp ) *  &
+                                         ( df_p - df_m ) / dzw(k) )
+
+          ENDIF
+
+       ENDDO
+
+    END SUBROUTINE calc_radiation_ij
+
+ END MODULE calc_radiation_mod
Index: lm/trunk/SOURCE/calc_radiation_mod.f90
===================================================================
--- /palm/trunk/SOURCE/calc_radiation_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,358 +1,0 @@
-!> @file calc_radiation_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1322 2014-03-20 16:38:49Z raasch
-! exponent 4.0 changed to integer
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! Revision 1.1  2000/04/13 14:42:45  schroeter
-! Initial revision
-!
-!
-! Description:
-! -------------
-!> Calculation of the vertical divergences of the long-wave radiation-fluxes
-!> based on the parameterization of the cloud effective emissivity
-!------------------------------------------------------------------------------!
- MODULE calc_radiation_mod
- 
-    USE kinds
-    
-    PRIVATE
-    PUBLIC calc_radiation
-    
-    LOGICAL, SAVE ::  first_call = .TRUE. !<
-    REAL(wp), SAVE ::  sigma = 5.67E-08_wp   !<
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  lwp_ground         !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  lwp_top            !<
-    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  blackbody_emission !<
-
-    INTERFACE calc_radiation
-       MODULE PROCEDURE calc_radiation
-       MODULE PROCEDURE calc_radiation_ij
-    END INTERFACE calc_radiation
- 
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE calc_radiation
-
-       USE arrays_3d,                                                          &
-           ONLY:  dzw, pt, ql, tend
-
-       USE cloud_parameters,                                                   &
-           ONLY:  cp, l_d_cp, pt_d_t, t_d_pt
-
-       USE control_parameters,                                                 &
-           ONLY:  rho_surface
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nyn, nys, nzb, nzb_s_inner, nzt
-
-       USE kinds
-
-       USE pegrid
-
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  k      !<
-       INTEGER(iwp) ::  k_help !<
- 
-       REAL(wp) :: df_p                      !<
-       REAL(wp) :: df_m                      !<
-       REAL(wp) :: effective_emission_up_m   !<
-       REAL(wp) :: effective_emission_up_p   !<
-       REAL(wp) :: effective_emission_down_m !<
-       REAL(wp) :: effective_emission_down_p !<
-       REAL(wp) :: f_up_m                    !<
-       REAL(wp) :: f_up_p                    !<
-       REAL(wp) :: f_down_m                  !<
-       REAL(wp) :: f_down_p                  !<
-       REAL(wp) :: impinging_flux_at_top     !<
-       REAL(wp) :: temperature               !<
-
-
-!
-!--    On first call, allocate temporary arrays
-       IF ( first_call )  THEN
-          ALLOCATE( blackbody_emission(nzb:nzt+1), lwp_ground(nzb:nzt+1),      &
-                    lwp_top(nzb:nzt+1) )
-          first_call = .FALSE.
-       ENDIF
-
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-!
-!--          Compute the liquid water path (LWP) and blackbody_emission
-!--          at all vertical levels
-             lwp_ground(nzb) = 0.0_wp
-             lwp_top(nzt+1)  = rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
-
-             temperature     = pt(nzb,j,i) * t_d_pt(nzb) + l_d_cp * ql(nzb,j,i)
-             blackbody_emission(nzb) = sigma * temperature**4
-
-             DO  k = nzb_s_inner(j,i)+1, nzt
-
-                k_help = ( nzt+nzb+1 ) - k
-                lwp_ground(k)   = lwp_ground(k-1) + rho_surface * ql(k,j,i) *  &
-                                  dzw(k)
-
-                lwp_top(k_help) = lwp_top(k_help+1) +                          &
-                                  rho_surface * ql(k_help,j,i) * dzw(k_help)
-
-                temperature     = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i)
-                blackbody_emission(k) = sigma * temperature**4
-
-             ENDDO
-
-             lwp_ground(nzt+1) = lwp_ground(nzt) +                             &
-                                 rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
-             lwp_top(nzb)      = lwp_top(nzb+1)
-
-             temperature       = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp *      &
-                                 ql(nzt+1,j,i)
-             blackbody_emission(nzt+1) = sigma * temperature**4
-
-!
-!--          See Chlond '92, this is just a first guess
-             impinging_flux_at_top = blackbody_emission(nzb) - 100.0_wp
-
-             DO  k = nzb_s_inner(j,i)+1, nzt
-!
-!--             Save some computational time, but this may cause load
-!--             imbalances if ql is not distributed uniformly
-                IF ( ql(k,j,i) /= 0.0_wp ) THEN
-!
-!--                Compute effective emissivities
-                   effective_emission_up_p   = 1.0_wp -                        &
-                                               EXP( -130.0_wp * lwp_ground(k+1) )
-                   effective_emission_up_m   = 1.0_wp -                        &
-                                               EXP( -130.0_wp * lwp_ground(k-1) )
-                   effective_emission_down_p = 1.0_wp -                        &
-                                               EXP( -158.0_wp * lwp_top(k+1) )
-                   effective_emission_down_m = 1.0_wp -                        &
-                                               EXP( -158.0_wp * lwp_top(k-1) )  
-
-!
-!--                Compute vertical long wave radiation fluxes
-                   f_up_p = blackbody_emission(nzb) +                          &
-                            effective_emission_up_p *                          &
-                           ( blackbody_emission(k) - blackbody_emission(nzb) )
-
-                   f_up_m = blackbody_emission(nzb) +                          &
-                            effective_emission_up_m *                          &
-                           ( blackbody_emission(k-1) - blackbody_emission(nzb) )
-
-                   f_down_p = impinging_flux_at_top +                          &
-                              effective_emission_down_p *                      &
-                             ( blackbody_emission(k) - impinging_flux_at_top )
-
-                   f_down_m = impinging_flux_at_top +                          &
-                              effective_emission_down_m *                      &
-                             ( blackbody_emission(k-1) - impinging_flux_at_top )
-
-!
-!--                Divergence of vertical long wave radiation fluxes
-                   df_p = f_up_p - f_down_p
-                   df_m = f_up_m - f_down_m
-
-!
-!--                Compute tendency term         
-                   tend(k,j,i) = tend(k,j,i) -                                 &
-                                ( pt_d_t(k) / ( rho_surface * cp ) *           &
-                                  ( df_p - df_m ) / dzw(k) )
-
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE calc_radiation
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE calc_radiation_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  dzw, pt, ql, tend
-
-       USE cloud_parameters,                                                   &
-           ONLY:  cp, l_d_cp, pt_d_t, t_d_pt
-
-       USE control_parameters,                                                 &
-           ONLY:  rho_surface
-
-       USE indices,                                                            &
-           ONLY:  nzb, nzb_s_inner, nzt
-
-       USE kinds
-
-       USE pegrid
-
-   
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  k      !<
-       INTEGER(iwp) ::  k_help !<
-
-       REAL(wp) :: df_p                      !<
-       REAL(wp) :: df_m                      !<
-       REAL(wp) :: effective_emission_up_m   !<
-       REAL(wp) :: effective_emission_up_p   !<
-       REAL(wp) :: effective_emission_down_m !<
-       REAL(wp) :: effective_emission_down_p !<
-       REAL(wp) :: f_up_m                    !<
-       REAL(wp) :: f_up_p                    !<
-       REAL(wp) :: f_down_m                  !<
-       REAL(wp) :: f_down_p                  !<
-       REAL(wp) :: impinging_flux_at_top     !<
-       REAL(wp) :: temperature               !<
-
-       
-!
-!--    On first call, allocate temporary arrays
-       IF ( first_call )  THEN
-          ALLOCATE( blackbody_emission(nzb:nzt+1), lwp_ground(nzb:nzt+1),      &
-                    lwp_top(nzb:nzt+1) )
-          first_call = .FALSE.
-       ENDIF
-
-!
-!--    Compute the liquid water path (LWP) and blackbody_emission
-!--    at all vertical levels
-       lwp_ground(nzb) = 0.0_wp
-       lwp_top(nzt+1)  = rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
-
-       temperature     = pt(nzb,j,i) * t_d_pt(nzb) + l_d_cp * ql(nzb,j,i)
-       blackbody_emission(nzb) = sigma * temperature**4
-
-       DO  k = nzb_s_inner(j,i)+1, nzt
-          k_help = ( nzt+nzb+1 ) - k
-          lwp_ground(k)   = lwp_ground(k-1) + rho_surface * ql(k,j,i) * dzw(k)
-
-          lwp_top(k_help) = lwp_top(k_help+1) +                                &
-                            rho_surface * ql(k_help,j,i) * dzw(k_help)
-
-          temperature     = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i)
-          blackbody_emission(k) = sigma * temperature**4
-
-       ENDDO
-       lwp_ground(nzt+1) = lwp_ground(nzt) +                                   &
-                           rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
-       lwp_top(nzb)      = lwp_top(nzb+1)
-
-       temperature       = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp *            &
-                           ql(nzt+1,j,i)
-       blackbody_emission(nzt+1) = sigma * temperature**4
-
-!
-!--    See Chlond '92, this is just a first guess
-       impinging_flux_at_top = blackbody_emission(nzb) - 100.0_wp
-
-       DO  k = nzb_s_inner(j,i)+1, nzt
-!
-!--       Store some computational time,
-!--       this may cause load imbalances if ql is not distributed uniformly
-          IF ( ql(k,j,i) /= 0.0_wp ) THEN
-!
-!--          Compute effective emissivities
-             effective_emission_up_p   = 1.0_wp -                              &
-                                         EXP( -130.0_wp * lwp_ground(k+1) )
-             effective_emission_up_m   = 1.0_wp -                              &
-                                         EXP( -130.0_wp * lwp_ground(k-1) )
-             effective_emission_down_p = 1.0_wp -                              &
-                                         EXP( -158.0_wp * lwp_top(k+1) )
-             effective_emission_down_m = 1.0_wp -                              &
-                                         EXP( -158.0_wp * lwp_top(k-1) )  
-             
-!
-!--          Compute vertical long wave radiation fluxes
-             f_up_p = blackbody_emission(nzb) + effective_emission_up_p *      &
-                     ( blackbody_emission(k) - blackbody_emission(nzb) )
-
-             f_up_m = blackbody_emission(nzb) + effective_emission_up_m *      &
-                     ( blackbody_emission(k-1) - blackbody_emission(nzb) )
-
-             f_down_p = impinging_flux_at_top + effective_emission_down_p *    &
-                       ( blackbody_emission(k) - impinging_flux_at_top )
-
-             f_down_m = impinging_flux_at_top + effective_emission_down_m *    &
-                       ( blackbody_emission(k-1) - impinging_flux_at_top )
-
-!
-!-           Divergence of vertical long wave radiation fluxes
-             df_p = f_up_p - f_down_p
-             df_m = f_up_m - f_down_m
-
-!
-!--          Compute tendency term         
-             tend(k,j,i) = tend(k,j,i) - ( pt_d_t(k) / ( rho_surface * cp ) *  &
-                                         ( df_p - df_m ) / dzw(k) )
-
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE calc_radiation_ij
-
- END MODULE calc_radiation_mod
Index: /palm/trunk/SOURCE/coriolis.f90
===================================================================
--- /palm/trunk/SOURCE/coriolis.f90	(revision 1873)
+++ /palm/trunk/SOURCE/coriolis.f90	(revision 1873)
@@ -0,0 +1,333 @@
+!> @file coriolis.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+! 
+! 1257 2013-11-08 15:18:40Z raasch
+! openacc loop and loop vector clauses removed
+!
+! 1128 2013-04-12 06:19:32Z raasch
+! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
+! j_north
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1015 2012-09-27 09:23:24Z raasch
+! accelerator version (*_acc) added
+!
+! Revision 1.1  1997/08/29 08:57:38  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Computation of all Coriolis terms in the equations of motion.
+!------------------------------------------------------------------------------!
+ MODULE coriolis_mod
+ 
+
+    PRIVATE
+    PUBLIC coriolis, coriolis_acc
+
+    INTERFACE coriolis
+       MODULE PROCEDURE coriolis
+       MODULE PROCEDURE coriolis_ij
+    END INTERFACE coriolis
+
+    INTERFACE coriolis_acc
+       MODULE PROCEDURE coriolis_acc
+    END INTERFACE coriolis_acc
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE coriolis( component )
+
+       USE arrays_3d,                                                          &
+           ONLY:  tend, u, ug, v, vg, w 
+           
+       USE control_parameters,                                                 &
+           ONLY:  f, fs, message_string
+           
+       USE indices,                                                            &
+           ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb_u_inner, nzb_v_inner,    &
+                  nzb_w_inner, nzt
+                   
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  component  !< 
+       INTEGER(iwp) ::  i          !< 
+       INTEGER(iwp) ::  j          !< 
+       INTEGER(iwp) ::  k          !< 
+
+
+!
+!--    Compute Coriolis terms for the three velocity components
+       SELECT CASE ( component )
+
+!
+!--       u-component
+          CASE ( 1 )
+             DO  i = nxlu, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_u_inner(j,i)+1, nzt
+                      tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *          &
+                                   ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +    &
+                                     v(k,j+1,i) ) - vg(k) )                    &
+                                                - fs *    ( 0.25_wp *          &
+                                   ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +  &
+                                     w(k,j,i)   ) &
+                                                          )
+                   ENDDO
+                ENDDO
+             ENDDO
+
+!
+!--       v-component
+          CASE ( 2 )
+             DO  i = nxl, nxr
+                DO  j = nysv, nyn
+                   DO  k = nzb_v_inner(j,i)+1, nzt
+                      tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *          &
+                                   ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +    &
+                                     u(k,j,i+1) ) - ug(k) )
+                   ENDDO
+                ENDDO
+             ENDDO
+
+!
+!--       w-component
+          CASE ( 3 )
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_w_inner(j,i)+1, nzt
+                      tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *               &
+                                   ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +      &
+                                     u(k+1,j,i+1) )
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE DEFAULT
+
+             WRITE( message_string, * ) ' wrong component: ', component
+             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
+
+       END SELECT
+
+    END SUBROUTINE coriolis
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE coriolis_acc( component )
+
+       USE arrays_3d,                                                          &
+           ONLY:  tend, u, ug, v, vg, w 
+           
+       USE control_parameters,                                                 &
+           ONLY:  f, fs, message_string
+           
+       USE indices,                                                            &
+           ONLY:  i_left, i_right, j_north, j_south, nzb_u_inner,              &
+                  nzb_v_inner, nzb_w_inner, nzt
+                   
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  component  !< 
+       INTEGER(iwp) ::  i          !<
+       INTEGER(iwp) ::  j          !< 
+       INTEGER(iwp) ::  k          !<
+
+
+!
+!--    Compute Coriolis terms for the three velocity components
+       SELECT CASE ( component )
+
+!
+!--       u-component
+          CASE ( 1 )
+             !$acc  kernels present( nzb_u_inner, tend, v, vg, w )
+             DO  i = i_left, i_right
+                DO  j = j_south, j_north
+                   DO  k = 1, nzt
+                      IF  ( k > nzb_u_inner(j,i) )  THEN
+                         tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *       &
+                                      ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
+                                        v(k,j+1,i) ) - vg(k) )                 &
+                                                   - fs *    ( 0.25_wp *       &
+                                      ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) &
+                                        + w(k,j,i)   )                         &
+                                                             )
+                      ENDIF
+                   ENDDO
+                ENDDO
+             ENDDO
+             !$acc end kernels
+
+!
+!--       v-component
+          CASE ( 2 )
+             !$acc  kernels present( nzb_v_inner, tend, u, ug )
+             DO  i = i_left, i_right
+                DO  j = j_south, j_north
+                   DO  k = 1, nzt
+                      IF  ( k > nzb_v_inner(j,i) )  THEN
+                         tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *       &
+                                      ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
+                                        u(k,j,i+1) ) - ug(k) )
+                      ENDIF
+                   ENDDO
+                ENDDO
+             ENDDO
+             !$acc end kernels
+
+!
+!--       w-component
+          CASE ( 3 )
+             !$acc  kernels present( nzb_w_inner, tend, u )
+             DO  i = i_left, i_right
+                DO  j = j_south, j_north
+                   DO  k = 1, nzt
+                      IF  ( k > nzb_w_inner(j,i) )  THEN
+                         tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *            &
+                                      ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +   &
+                                        u(k+1,j,i+1) )
+                      ENDIF
+                   ENDDO
+                ENDDO
+             ENDDO
+             !$acc end kernels
+
+          CASE DEFAULT
+
+             WRITE( message_string, * ) ' wrong component: ', component
+             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
+
+       END SELECT
+
+    END SUBROUTINE coriolis_acc
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE coriolis_ij( i, j, component )
+
+       USE arrays_3d,                                                          &
+           ONLY:  tend, u, ug, v, vg, w 
+           
+       USE control_parameters,                                                 &
+           ONLY:  f, fs, message_string
+           
+       USE indices,                                                            &
+           ONLY:  nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
+           
+       USE kinds
+       
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  component  !< 
+       INTEGER(iwp) ::  i          !<
+       INTEGER(iwp) ::  j          !< 
+       INTEGER(iwp) ::  k          !<
+
+!
+!--    Compute Coriolis terms for the three velocity components
+       SELECT CASE ( component )
+
+!
+!--       u-component
+          CASE ( 1 )
+             DO  k = nzb_u_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *                &
+                                ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +       &
+                                  v(k,j+1,i) ) - vg(k) )                       &
+                                          - fs *    ( 0.25_wp *                &
+                                ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +     &
+                                  w(k,j,i)   ) )
+             ENDDO
+
+!
+!--       v-component
+          CASE ( 2 )
+             DO  k = nzb_v_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *                &
+                                ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +       &
+                                  u(k,j,i+1) ) - ug(k) )
+             ENDDO
+
+!
+!--       w-component
+          CASE ( 3 )
+             DO  k = nzb_w_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *                     &
+                                ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +         &
+                                  u(k+1,j,i+1) )
+             ENDDO
+
+          CASE DEFAULT
+
+             WRITE( message_string, * ) ' wrong component: ', component
+             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
+
+       END SELECT
+
+    END SUBROUTINE coriolis_ij
+
+ END MODULE coriolis_mod
Index: lm/trunk/SOURCE/coriolis_mod.f90
===================================================================
--- /palm/trunk/SOURCE/coriolis_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,332 +1,0 @@
-!> @file coriolis_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-! 
-! 1257 2013-11-08 15:18:40Z raasch
-! openacc loop and loop vector clauses removed
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! accelerator version (*_acc) added
-!
-! Revision 1.1  1997/08/29 08:57:38  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Computation of all Coriolis terms in the equations of motion.
-!------------------------------------------------------------------------------!
- MODULE coriolis_mod
- 
-
-    PRIVATE
-    PUBLIC coriolis, coriolis_acc
-
-    INTERFACE coriolis
-       MODULE PROCEDURE coriolis
-       MODULE PROCEDURE coriolis_ij
-    END INTERFACE coriolis
-
-    INTERFACE coriolis_acc
-       MODULE PROCEDURE coriolis_acc
-    END INTERFACE coriolis_acc
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE coriolis( component )
-
-       USE arrays_3d,                                                          &
-           ONLY:  tend, u, ug, v, vg, w 
-           
-       USE control_parameters,                                                 &
-           ONLY:  f, fs, message_string
-           
-       USE indices,                                                            &
-           ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb_u_inner, nzb_v_inner,    &
-                  nzb_w_inner, nzt
-                   
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  component  !< 
-       INTEGER(iwp) ::  i          !< 
-       INTEGER(iwp) ::  j          !< 
-       INTEGER(iwp) ::  k          !< 
-
-
-!
-!--    Compute Coriolis terms for the three velocity components
-       SELECT CASE ( component )
-
-!
-!--       u-component
-          CASE ( 1 )
-             DO  i = nxlu, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_u_inner(j,i)+1, nzt
-                      tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *          &
-                                   ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +    &
-                                     v(k,j+1,i) ) - vg(k) )                    &
-                                                - fs *    ( 0.25_wp *          &
-                                   ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +  &
-                                     w(k,j,i)   ) &
-                                                          )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-!
-!--       v-component
-          CASE ( 2 )
-             DO  i = nxl, nxr
-                DO  j = nysv, nyn
-                   DO  k = nzb_v_inner(j,i)+1, nzt
-                      tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *          &
-                                   ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +    &
-                                     u(k,j,i+1) ) - ug(k) )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-!
-!--       w-component
-          CASE ( 3 )
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_w_inner(j,i)+1, nzt
-                      tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *               &
-                                   ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +      &
-                                     u(k+1,j,i+1) )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-          CASE DEFAULT
-
-             WRITE( message_string, * ) ' wrong component: ', component
-             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
-
-       END SELECT
-
-    END SUBROUTINE coriolis
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE coriolis_acc( component )
-
-       USE arrays_3d,                                                          &
-           ONLY:  tend, u, ug, v, vg, w 
-           
-       USE control_parameters,                                                 &
-           ONLY:  f, fs, message_string
-           
-       USE indices,                                                            &
-           ONLY:  i_left, i_right, j_north, j_south, nzb_u_inner,              &
-                  nzb_v_inner, nzb_w_inner, nzt
-                   
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  component  !< 
-       INTEGER(iwp) ::  i          !<
-       INTEGER(iwp) ::  j          !< 
-       INTEGER(iwp) ::  k          !<
-
-
-!
-!--    Compute Coriolis terms for the three velocity components
-       SELECT CASE ( component )
-
-!
-!--       u-component
-          CASE ( 1 )
-             !$acc  kernels present( nzb_u_inner, tend, v, vg, w )
-             DO  i = i_left, i_right
-                DO  j = j_south, j_north
-                   DO  k = 1, nzt
-                      IF  ( k > nzb_u_inner(j,i) )  THEN
-                         tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *       &
-                                      ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
-                                        v(k,j+1,i) ) - vg(k) )                 &
-                                                   - fs *    ( 0.25_wp *       &
-                                      ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) &
-                                        + w(k,j,i)   )                         &
-                                                             )
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$acc end kernels
-
-!
-!--       v-component
-          CASE ( 2 )
-             !$acc  kernels present( nzb_v_inner, tend, u, ug )
-             DO  i = i_left, i_right
-                DO  j = j_south, j_north
-                   DO  k = 1, nzt
-                      IF  ( k > nzb_v_inner(j,i) )  THEN
-                         tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *       &
-                                      ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
-                                        u(k,j,i+1) ) - ug(k) )
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$acc end kernels
-
-!
-!--       w-component
-          CASE ( 3 )
-             !$acc  kernels present( nzb_w_inner, tend, u )
-             DO  i = i_left, i_right
-                DO  j = j_south, j_north
-                   DO  k = 1, nzt
-                      IF  ( k > nzb_w_inner(j,i) )  THEN
-                         tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *            &
-                                      ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +   &
-                                        u(k+1,j,i+1) )
-                      ENDIF
-                   ENDDO
-                ENDDO
-             ENDDO
-             !$acc end kernels
-
-          CASE DEFAULT
-
-             WRITE( message_string, * ) ' wrong component: ', component
-             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
-
-       END SELECT
-
-    END SUBROUTINE coriolis_acc
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE coriolis_ij( i, j, component )
-
-       USE arrays_3d,                                                          &
-           ONLY:  tend, u, ug, v, vg, w 
-           
-       USE control_parameters,                                                 &
-           ONLY:  f, fs, message_string
-           
-       USE indices,                                                            &
-           ONLY:  nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
-           
-       USE kinds
-       
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  component  !< 
-       INTEGER(iwp) ::  i          !<
-       INTEGER(iwp) ::  j          !< 
-       INTEGER(iwp) ::  k          !<
-
-!
-!--    Compute Coriolis terms for the three velocity components
-       SELECT CASE ( component )
-
-!
-!--       u-component
-          CASE ( 1 )
-             DO  k = nzb_u_inner(j,i)+1, nzt
-                tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *                &
-                                ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +       &
-                                  v(k,j+1,i) ) - vg(k) )                       &
-                                          - fs *    ( 0.25_wp *                &
-                                ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +     &
-                                  w(k,j,i)   ) )
-             ENDDO
-
-!
-!--       v-component
-          CASE ( 2 )
-             DO  k = nzb_v_inner(j,i)+1, nzt
-                tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *                &
-                                ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +       &
-                                  u(k,j,i+1) ) - ug(k) )
-             ENDDO
-
-!
-!--       w-component
-          CASE ( 3 )
-             DO  k = nzb_w_inner(j,i)+1, nzt
-                tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *                     &
-                                ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +         &
-                                  u(k+1,j,i+1) )
-             ENDDO
-
-          CASE DEFAULT
-
-             WRITE( message_string, * ) ' wrong component: ', component
-             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
-
-       END SELECT
-
-    END SUBROUTINE coriolis_ij
-
- END MODULE coriolis_mod
Index: /palm/trunk/SOURCE/data_output_dvrp.f90
===================================================================
--- /palm/trunk/SOURCE/data_output_dvrp.f90	(revision 1873)
+++ /palm/trunk/SOURCE/data_output_dvrp.f90	(revision 1873)
@@ -0,0 +1,545 @@
+!> @file data_output_dvrp.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+!
+! 
+! 1822 2016-04-07 07:49:42Z hoffmann
+! Particles and tails removed.
+!
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1346 2014-03-27 13:18:20Z heinze
+! Bugfix: REAL constants provided with KIND-attribute especially in call of 
+! intrinsic function like MAX, MIN, SIGN
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1318 2014-03-17 13:35:16Z raasch
+! module interfaces removed
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 828 2012-02-21 12:00:36Z raasch
+! particle feature color renamed class
+!
+! Revision 1.1  2000/04/27 06:27:17  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Plot of isosurface and slicers with dvrp-software
+!------------------------------------------------------------------------------!
+ MODULE dvrp_color
+ 
+
+    USE dvrp_variables
+    
+    USE kinds
+
+    IMPLICIT NONE
+
+ CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> @todo Missing subroutine description.
+!------------------------------------------------------------------------------!
+    SUBROUTINE color_dvrp( value, color )
+
+       REAL(wp), INTENT(IN)  ::  value    !< 
+       REAL(wp), INTENT(OUT) ::  color(4) !< 
+
+       REAL(wp)              ::  scale    !< 
+
+       scale = ( value - slicer_range_limits_dvrp(1,islice_dvrp) ) /           &
+               ( slicer_range_limits_dvrp(2,islice_dvrp) -                     &
+                 slicer_range_limits_dvrp(1,islice_dvrp) )
+
+       scale = MODULO( 180.0_wp + 180.0_wp * scale, 360.0_wp )
+
+       color = (/ scale, 0.5_wp, 1.0_wp, 0.0_wp /)
+
+    END SUBROUTINE color_dvrp
+
+ END MODULE dvrp_color
+
+
+ RECURSIVE SUBROUTINE data_output_dvrp
+
+#if defined( __dvrp_graphics )
+
+    USE arrays_3d,                                                             &
+        ONLY:  p, pt, q, ql, ts, u, us, v, w, zu
+        
+    USE cloud_parameters,                                                      &
+        ONLY:  l_d_cp, pt_d_t
+        
+    USE constants,                                                             &
+        ONLY:  pi
+        
+    USE control_parameters,                                                    &
+        ONLY:  cloud_droplets, cloud_physics, do2d, do3d, humidity, ibc_uv_b,  &
+               message_string, nz_do3d, passive_scalar, simulated_time,        &
+               threshold
+        
+    USE cpulog,                                                                &
+        ONLY:  log_point, log_point_s, cpu_log
+        
+    USE DVRP
+    
+    USE dvrp_color
+        
+    USE dvrp_variables
+        
+    USE grid_variables,                                                        &
+        ONLY:  dx, dy
+        
+    USE indices,                                                               &
+        ONLY:  nxl, nxr, nyn, nys, nzb
+        
+    USE kinds
+
+    USE pegrid
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=2) ::  section_chr      !< 
+    CHARACTER (LEN=6) ::  output_variable  !< 
+    
+    INTEGER(iwp) ::  c_mode           !<  
+    INTEGER(iwp) ::  c_size_x         !< 
+    INTEGER(iwp) ::  c_size_y         !< 
+    INTEGER(iwp) ::  c_size_z         !< 
+    INTEGER(iwp) ::  dvrp_nop         !< 
+    INTEGER(iwp) ::  dvrp_not         !< 
+    INTEGER(iwp) ::  gradient_normals !< 
+    INTEGER(iwp) ::  i                !< 
+    INTEGER(iwp) ::  ip               !< 
+    INTEGER(iwp) ::  j                !< 
+    INTEGER(iwp) ::  jp               !< 
+    INTEGER(iwp) ::  k                !< 
+    INTEGER(iwp) ::  l                !< 
+    INTEGER(iwp) ::  m                !< 
+    INTEGER(iwp) ::  n                !< 
+    INTEGER(iwp) ::  n_isosurface     !< 
+    INTEGER(iwp) ::  n_slicer         !< 
+    INTEGER(iwp) ::  nn               !< 
+    INTEGER(iwp) ::  section_mode     !< 
+    INTEGER(iwp) ::  vn               !< 
+    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  p_c  !< 
+    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  p_t  !< 
+
+    LOGICAL, DIMENSION(:), ALLOCATABLE ::  dvrp_mask  !< 
+
+    REAL(sp) ::  slicer_position  !< 
+    REAL(sp) ::  tmp_alpha        !< 
+    REAL(sp) ::  tmp_alpha_w      !< 
+    REAL(sp) ::  tmp_b            !< 
+    REAL(sp) ::  tmp_c_alpha      !< 
+    REAL(sp) ::  tmp_g            !< 
+    REAL(sp) ::  tmp_norm         !< 
+    REAL(sp) ::  tmp_pos          !< 
+    REAL(sp) ::  tmp_r            !< 
+    REAL(sp) ::  tmp_t            !< 
+    REAL(sp) ::  tmp_th           !< 
+    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  psize  !< 
+    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_x    !< 
+    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_y    !< 
+    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_z    !< 
+    REAL(sp), DIMENSION(:,:,:), ALLOCATABLE   ::  local_pf  !< 
+    REAL(sp), DIMENSION(:,:,:,:), ALLOCATABLE ::  local_pfi !< 
+
+
+    CALL cpu_log( log_point(27), 'data_output_dvrp', 'start' )
+
+!
+!-- Loop over all output modes choosed
+    m            = 1
+    n_isosurface = 0  ! isosurface counter (for threshold values and color)
+    n_slicer     = 0  ! slice plane counter (for range of values)
+    DO WHILE ( mode_dvrp(m) /= ' ' )
+!
+!--    Update of the steering variables
+       IF ( .NOT. lock_steering_update )  THEN
+!
+!--       Set lock to avoid recursive calls of DVRP_STEERING_UPDATE
+          lock_steering_update = .TRUE.
+!          CALL DVRP_STEERING_UPDATE( m-1, data_output_dvrp )
+          lock_steering_update = .FALSE.
+       ENDIF
+
+!
+!--    Determine the variable which shall be plotted (in case of slicers or
+!--    isosurfaces)
+       IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
+          READ ( mode_dvrp(m), '(10X,I2)' )  vn
+          output_variable = do3d(0,vn)
+          n_isosurface = n_isosurface + 1
+       ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
+          READ ( mode_dvrp(m), '(6X,I2)' )  vn
+          output_variable = do2d(0,vn)
+          l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
+          section_chr = do2d(0,vn)(l-1:l)
+          SELECT CASE ( section_chr )
+             CASE ( 'xy' )
+                section_mode = 2
+                slicer_position = zu(MIN( slicer_position_dvrp(m), nz_do3d ))
+             CASE ( 'xz' )
+                section_mode = 1
+                slicer_position = slicer_position_dvrp(m) * dy
+             CASE ( 'yz' )
+                section_mode = 0
+                slicer_position = slicer_position_dvrp(m) * dx
+          END SELECT
+       ENDIF
+
+!
+!--    Select the plot mode (in case of isosurface or slicer only if user has
+!--    defined a variable which shall be plotted; otherwise do nothing)
+       IF ( ( mode_dvrp(m)(1:10) == 'isosurface'  .OR.                     &
+                  mode_dvrp(m)(1:6)  == 'slicer'           )                   &
+                  .AND.  output_variable /= ' ' )  THEN
+
+!
+!--       Create an intermediate array, properly dimensioned for plot-output 
+          ALLOCATE( local_pf(nxl_dvrp:nxr_dvrp+1,nys_dvrp:nyn_dvrp+1,          &
+                             nzb:nz_do3d) )
+
+!
+!--       Move original array to intermediate array
+          IF ( dvrp_overlap )  THEN
+
+             SELECT CASE ( output_variable )
+
+                CASE ( 'u', 'u_xy', 'u_xz', 'u_yz' )
+                   DO  i = nxl_dvrp, nxr_dvrp+1
+                      DO  j = nys_dvrp, nyn_dvrp+1
+                         DO  k = nzb, nz_do3d
+                            local_pf(i,j,k) = u(k,j,i)
+                         ENDDO
+                      ENDDO
+                   ENDDO
+!
+!--                Replace mirrored values at lower surface by real surface
+!--                values
+                   IF ( output_variable == 'u_xz'  .OR.                        &
+                        output_variable == 'u_yz' )  THEN
+                      IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0_wp
+                   ENDIF
+
+
+                CASE ( 'v', 'v_xy', 'v_xz', 'v_yz' )
+                   DO  i = nxl_dvrp, nxr_dvrp+1
+                      DO  j = nys_dvrp, nyn_dvrp+1
+                         DO  k = nzb, nz_do3d
+                            local_pf(i,j,k) = v(k,j,i)
+                         ENDDO
+                      ENDDO
+                   ENDDO
+!
+!--                Replace mirrored values at lower surface by real surface
+!--                values
+                   IF ( output_variable == 'v_xz'  .OR.                        &
+                        output_variable == 'v_yz' )  THEN
+                      IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0_wp
+                   ENDIF
+
+                CASE ( 'w', 'w_xy', 'w_xz', 'w_yz' )
+                   DO  i = nxl_dvrp, nxr_dvrp+1
+                      DO  j = nys_dvrp, nyn_dvrp+1
+                         DO  k = nzb, nz_do3d
+                            local_pf(i,j,k) = w(k,j,i)
+                         ENDDO
+                      ENDDO
+                   ENDDO
+! Averaging for Langmuir circulation
+!                   DO  k = nzb, nz_do3d
+!                      DO  j = nys_dvrp+1, nyn_dvrp
+!                         DO  i = nxl_dvrp, nxr_dvrp+1
+!                            local_pf(i,j,k) = 0.25 * local_pf(i,j-1,k) + &
+!                                              0.50 * local_pf(i,j,k)   + &
+!                                              0.25 * local_pf(i,j+1,k)
+!                         ENDDO
+!                      ENDDO
+!                   ENDDO
+
+                CASE ( 'p', 'p_xy', 'p_xz', 'p_yz' )
+                   DO  i = nxl_dvrp, nxr_dvrp+1
+                      DO  j = nys_dvrp, nyn_dvrp+1
+                         DO  k = nzb, nz_do3d
+                            local_pf(i,j,k) = p(k,j,i)
+                         ENDDO
+                      ENDDO
+                   ENDDO
+
+                CASE ( 'pt', 'pt_xy', 'pt_xz', 'pt_yz' )
+                   IF ( .NOT. cloud_physics ) THEN
+                      DO  i = nxl_dvrp, nxr_dvrp+1
+                         DO  j = nys_dvrp, nyn_dvrp+1
+                            DO  k = nzb, nz_do3d
+                               local_pf(i,j,k) = pt(k,j,i)
+                            ENDDO
+                         ENDDO
+                      ENDDO
+                   ELSE
+                      DO  i = nxl_dvrp, nxr_dvrp+1
+                         DO  j = nys_dvrp, nyn_dvrp+1
+                            DO  k = nzb, nz_do3d
+                               local_pf(i,j,k) = pt(k,j,i) + l_d_cp *          &
+                                                 pt_d_t(k) * ql(k,j,i)
+                            ENDDO
+                         ENDDO
+                      ENDDO
+                   ENDIF
+
+                CASE ( 'q', 'q_xy', 'q_xz', 'q_yz' )
+                   IF ( humidity  .OR.  passive_scalar )  THEN
+                      DO  i = nxl_dvrp, nxr_dvrp+1
+                         DO  j = nys_dvrp, nyn_dvrp+1
+                            DO  k = nzb, nz_do3d
+                               local_pf(i,j,k) = q(k,j,i)
+                            ENDDO
+                         ENDDO
+                      ENDDO            
+                   ELSE                    
+                      message_string = 'if humidity/passive_scalar = '    //   & 
+                            'FALSE output of ' // TRIM( output_variable ) //   &
+                            'is not provided' 
+                      CALL message( 'data_output_dvrp', 'PA0183',&
+                                                                 0, 0, 0, 6, 0 )
+                   ENDIF
+             
+                CASE ( 'ql', 'ql_xy', 'ql_xz', 'ql_yz' )
+                   IF ( cloud_physics  .OR.  cloud_droplets )  THEN
+                      DO  i = nxl_dvrp, nxr_dvrp+1
+                         DO  j = nys_dvrp, nyn_dvrp+1
+                            DO  k = nzb, nz_do3d
+                               local_pf(i,j,k) = ql(k,j,i)
+                            ENDDO
+                         ENDDO
+                      ENDDO
+                   ELSE                     
+                      message_string = 'if cloud_physics = FALSE '       //    & 
+                                  'output of ' // TRIM( output_variable) //    &
+                                  'is not provided' 
+                      CALL message( 'data_output_dvrp', 'PA0184',&
+                                                                 0, 0, 0, 6, 0 )
+                   ENDIF
+
+                CASE ( 'u*_xy' )
+                   DO  i = nxl_dvrp, nxr_dvrp+1
+                      DO  j = nys_dvrp, nyn_dvrp+1
+                         local_pf(i,j,nzb+1) = us(j,i)
+                      ENDDO
+                   ENDDO
+                   slicer_position = zu(nzb+1)
+
+                CASE ( 't*_xy' )
+                   DO  i = nxl_dvrp, nxr_dvrp+1
+                      DO  j = nys_dvrp, nyn_dvrp+1
+                         local_pf(i,j,nzb+1) = ts(j,i)
+                      ENDDO
+                   ENDDO
+                   slicer_position = zu(nzb+1)
+
+
+                CASE DEFAULT
+!
+!--                The DEFAULT case is reached either if output_variable
+!--                contains unsupported variable or if the user has coded a
+!--                special case in the user interface. There, the subroutine
+!--                user_data_output_dvrp checks which of these two conditions
+!--                applies.
+                   CALL user_data_output_dvrp( output_variable, local_pf )
+
+
+             END SELECT
+
+          ELSE
+!
+!--          No overlap of clipping domain with the current subdomain
+             DO  i = nxl_dvrp, nxr_dvrp+1
+                DO  j = nys_dvrp, nyn_dvrp+1
+                   DO  k = nzb, nz_do3d
+                      local_pf(i,j,k) = 0.0_wp
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          ENDIF
+
+          IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
+
+!
+!--          DVRP-Calls for plotting isosurfaces:
+             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'start' )
+
+!
+!--          Definition of isosurface color
+             tmp_r = isosurface_color(1,n_isosurface)
+             tmp_g = isosurface_color(2,n_isosurface)
+             tmp_b = isosurface_color(3,n_isosurface)
+             tmp_t = 0.0_wp
+             CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
+
+!
+!--          Compute and plot isosurface in dvr-format
+             CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp,      &
+                             cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
+
+             c_size_x = vc_size_x;  c_size_y = vc_size_y;  c_size_z = vc_size_z
+             CALL DVRP_CLUSTER_SIZE( m-1, c_size_x, c_size_y, c_size_z )
+
+             c_mode   = vc_mode 
+             CALL DVRP_CLUSTERING_MODE( m-1, c_mode )
+
+             gradient_normals = vc_gradient_normals
+             CALL DVRP_GRADIENTNORMALS( m-1, gradient_normals )
+
+!
+!--          A seperate procedure for setting vc_alpha will be in the next
+!--          version of libDVRP
+             tmp_c_alpha = vc_alpha 
+             CALL DVRP_THRESHOLD( -(m-1)-1, tmp_c_alpha )
+
+             IF ( dvrp_overlap )  THEN
+                tmp_th = threshold(n_isosurface)
+             ELSE
+                tmp_th = 1.0_wp  ! nothing is plotted because array values are 0
+             ENDIF
+
+             CALL DVRP_THRESHOLD( m-1, tmp_th )
+
+             CALL DVRP_VISUALIZE( m-1, 21, dvrp_filecount )
+
+             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'stop' )
+
+          ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
+
+!
+!--          DVRP-Calls for plotting slicers:
+             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'start' )
+
+!
+!--          Material and color definitions
+             tmp_r = 0.0_wp;  tmp_g = 0.0_wp;  tmp_b = 0.0_wp;  tmp_t = 0.0_wp
+             CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
+
+             n_slicer = n_slicer + 1
+
+!
+!--           Using dolorfunction has not been properly tested
+!             islice_dvrp = n_slicer
+!             CALL DVRP_COLORFUNCTION( m-1, DVRP_CM_HLS, 25,                 &
+!                                      slicer_range_limits_dvrp(:,n_slicer), &
+!                                      color_dvrp )
+
+!
+!--          Set interval of values defining the colortable
+             CALL set_slicer_attributes_dvrp( n_slicer )
+
+!
+!--          Create user-defined colortable
+             CALL user_dvrp_coltab( 'slicer', output_variable )
+
+             CALL DVRP_COLORTABLE_HLS( m-1, 1, interval_values_dvrp,           &
+                                       interval_h_dvrp, interval_l_dvrp,       &
+                                       interval_s_dvrp, interval_a_dvrp )
+
+!
+!--          Compute and plot slicer in dvr-format
+             CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp,      &
+                             cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
+             tmp_pos = slicer_position
+             CALL DVRP_SLICER( m-1, section_mode, tmp_pos )
+
+             CALL DVRP_VISUALIZE( m-1, 2, dvrp_filecount )
+
+             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'stop' )
+
+          ENDIF
+
+          DEALLOCATE( local_pf )
+
+       ELSEIF ( mode_dvrp(m)(1:9) == 'pathlines' ) THEN
+
+          ALLOCATE( local_pfi(4,nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
+          DO  i = nxl, nxr+1
+             DO  j = nys, nyn+1
+                DO  k = nzb, nz_do3d
+                   local_pfi(1,i,j,k) = u(k,j,i)
+                   local_pfi(2,i,j,k) = v(k,j,i)
+                   local_pfi(3,i,j,k) = w(k,j,i)
+                   tmp_norm           = SQRT( u(k,j,i) * u(k,j,i) +            &
+                                              v(k,j,i) * v(k,j,i) +            &
+                                              w(k,j,i) * w(k,j,i) )
+                   tmp_alpha          = ACOS( 0.0_wp * u(k,j,i) / tmp_norm +   &
+                                              0.0_wp * v(k,j,i) / tmp_norm -   &
+                                              1.0_wp * w(k,j,i) / tmp_norm )
+                   tmp_alpha_w        = tmp_alpha / pi * 180.0_wp
+                   local_pfi(4,i,j,k) = tmp_alpha_w
+                ENDDO
+             ENDDO
+          ENDDO
+
+          CALL cpu_log( log_point_s(31), 'dvrp_pathlines', 'start' )
+
+          CALL DVRP_DATA( m-1, local_pfi, 4, nx_dvrp, ny_dvrp, nz_dvrp, &
+                          cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
+          CALL DVRP_VISUALIZE( m-1, 20, dvrp_filecount )
+
+          CALL cpu_log( log_point_s(31), 'dvrp_pathlines', 'stop' )
+
+          DEALLOCATE( local_pfi )
+
+       ENDIF
+
+       m = m + 1
+
+    ENDDO
+
+    dvrp_filecount = dvrp_filecount + 1
+
+    CALL cpu_log( log_point(27), 'data_output_dvrp', 'stop' )
+
+#endif
+ END SUBROUTINE data_output_dvrp
Index: lm/trunk/SOURCE/data_output_dvrp_mod.f90
===================================================================
--- /palm/trunk/SOURCE/data_output_dvrp_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,544 +1,0 @@
-!> @file data_output_dvrp_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-!
-! 
-! 1822 2016-04-07 07:49:42Z hoffmann
-! Particles and tails removed.
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1346 2014-03-27 13:18:20Z heinze
-! Bugfix: REAL constants provided with KIND-attribute especially in call of 
-! intrinsic function like MAX, MIN, SIGN
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1318 2014-03-17 13:35:16Z raasch
-! module interfaces removed
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 828 2012-02-21 12:00:36Z raasch
-! particle feature color renamed class
-!
-! Revision 1.1  2000/04/27 06:27:17  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Plot of isosurface and slicers with dvrp-software
-!------------------------------------------------------------------------------!
- MODULE dvrp_color
- 
-
-    USE dvrp_variables
-    
-    USE kinds
-
-    IMPLICIT NONE
-
- CONTAINS
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!------------------------------------------------------------------------------!
-    SUBROUTINE color_dvrp( value, color )
-
-       REAL(wp), INTENT(IN)  ::  value    !< 
-       REAL(wp), INTENT(OUT) ::  color(4) !< 
-
-       REAL(wp)              ::  scale    !< 
-
-       scale = ( value - slicer_range_limits_dvrp(1,islice_dvrp) ) /           &
-               ( slicer_range_limits_dvrp(2,islice_dvrp) -                     &
-                 slicer_range_limits_dvrp(1,islice_dvrp) )
-
-       scale = MODULO( 180.0_wp + 180.0_wp * scale, 360.0_wp )
-
-       color = (/ scale, 0.5_wp, 1.0_wp, 0.0_wp /)
-
-    END SUBROUTINE color_dvrp
-
- END MODULE dvrp_color
-
-
- RECURSIVE SUBROUTINE data_output_dvrp
-
-#if defined( __dvrp_graphics )
-
-    USE arrays_3d,                                                             &
-        ONLY:  p, pt, q, ql, ts, u, us, v, w, zu
-        
-    USE cloud_parameters,                                                      &
-        ONLY:  l_d_cp, pt_d_t
-        
-    USE constants,                                                             &
-        ONLY:  pi
-        
-    USE control_parameters,                                                    &
-        ONLY:  cloud_droplets, cloud_physics, do2d, do3d, humidity, ibc_uv_b,  &
-               message_string, nz_do3d, passive_scalar, simulated_time,        &
-               threshold
-        
-    USE cpulog,                                                                &
-        ONLY:  log_point, log_point_s, cpu_log
-        
-    USE DVRP
-    
-    USE dvrp_color
-        
-    USE dvrp_variables
-        
-    USE grid_variables,                                                        &
-        ONLY:  dx, dy
-        
-    USE indices,                                                               &
-        ONLY:  nxl, nxr, nyn, nys, nzb
-        
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=2) ::  section_chr      !< 
-    CHARACTER (LEN=6) ::  output_variable  !< 
-    
-    INTEGER(iwp) ::  c_mode           !<  
-    INTEGER(iwp) ::  c_size_x         !< 
-    INTEGER(iwp) ::  c_size_y         !< 
-    INTEGER(iwp) ::  c_size_z         !< 
-    INTEGER(iwp) ::  dvrp_nop         !< 
-    INTEGER(iwp) ::  dvrp_not         !< 
-    INTEGER(iwp) ::  gradient_normals !< 
-    INTEGER(iwp) ::  i                !< 
-    INTEGER(iwp) ::  ip               !< 
-    INTEGER(iwp) ::  j                !< 
-    INTEGER(iwp) ::  jp               !< 
-    INTEGER(iwp) ::  k                !< 
-    INTEGER(iwp) ::  l                !< 
-    INTEGER(iwp) ::  m                !< 
-    INTEGER(iwp) ::  n                !< 
-    INTEGER(iwp) ::  n_isosurface     !< 
-    INTEGER(iwp) ::  n_slicer         !< 
-    INTEGER(iwp) ::  nn               !< 
-    INTEGER(iwp) ::  section_mode     !< 
-    INTEGER(iwp) ::  vn               !< 
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  p_c  !< 
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  p_t  !< 
-
-    LOGICAL, DIMENSION(:), ALLOCATABLE ::  dvrp_mask  !< 
-
-    REAL(sp) ::  slicer_position  !< 
-    REAL(sp) ::  tmp_alpha        !< 
-    REAL(sp) ::  tmp_alpha_w      !< 
-    REAL(sp) ::  tmp_b            !< 
-    REAL(sp) ::  tmp_c_alpha      !< 
-    REAL(sp) ::  tmp_g            !< 
-    REAL(sp) ::  tmp_norm         !< 
-    REAL(sp) ::  tmp_pos          !< 
-    REAL(sp) ::  tmp_r            !< 
-    REAL(sp) ::  tmp_t            !< 
-    REAL(sp) ::  tmp_th           !< 
-    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  psize  !< 
-    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_x    !< 
-    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_y    !< 
-    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_z    !< 
-    REAL(sp), DIMENSION(:,:,:), ALLOCATABLE   ::  local_pf  !< 
-    REAL(sp), DIMENSION(:,:,:,:), ALLOCATABLE ::  local_pfi !< 
-
-
-    CALL cpu_log( log_point(27), 'data_output_dvrp', 'start' )
-
-!
-!-- Loop over all output modes choosed
-    m            = 1
-    n_isosurface = 0  ! isosurface counter (for threshold values and color)
-    n_slicer     = 0  ! slice plane counter (for range of values)
-    DO WHILE ( mode_dvrp(m) /= ' ' )
-!
-!--    Update of the steering variables
-       IF ( .NOT. lock_steering_update )  THEN
-!
-!--       Set lock to avoid recursive calls of DVRP_STEERING_UPDATE
-          lock_steering_update = .TRUE.
-!          CALL DVRP_STEERING_UPDATE( m-1, data_output_dvrp )
-          lock_steering_update = .FALSE.
-       ENDIF
-
-!
-!--    Determine the variable which shall be plotted (in case of slicers or
-!--    isosurfaces)
-       IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
-          READ ( mode_dvrp(m), '(10X,I2)' )  vn
-          output_variable = do3d(0,vn)
-          n_isosurface = n_isosurface + 1
-       ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
-          READ ( mode_dvrp(m), '(6X,I2)' )  vn
-          output_variable = do2d(0,vn)
-          l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
-          section_chr = do2d(0,vn)(l-1:l)
-          SELECT CASE ( section_chr )
-             CASE ( 'xy' )
-                section_mode = 2
-                slicer_position = zu(MIN( slicer_position_dvrp(m), nz_do3d ))
-             CASE ( 'xz' )
-                section_mode = 1
-                slicer_position = slicer_position_dvrp(m) * dy
-             CASE ( 'yz' )
-                section_mode = 0
-                slicer_position = slicer_position_dvrp(m) * dx
-          END SELECT
-       ENDIF
-
-!
-!--    Select the plot mode (in case of isosurface or slicer only if user has
-!--    defined a variable which shall be plotted; otherwise do nothing)
-       IF ( ( mode_dvrp(m)(1:10) == 'isosurface'  .OR.                     &
-                  mode_dvrp(m)(1:6)  == 'slicer'           )                   &
-                  .AND.  output_variable /= ' ' )  THEN
-
-!
-!--       Create an intermediate array, properly dimensioned for plot-output 
-          ALLOCATE( local_pf(nxl_dvrp:nxr_dvrp+1,nys_dvrp:nyn_dvrp+1,          &
-                             nzb:nz_do3d) )
-
-!
-!--       Move original array to intermediate array
-          IF ( dvrp_overlap )  THEN
-
-             SELECT CASE ( output_variable )
-
-                CASE ( 'u', 'u_xy', 'u_xz', 'u_yz' )
-                   DO  i = nxl_dvrp, nxr_dvrp+1
-                      DO  j = nys_dvrp, nyn_dvrp+1
-                         DO  k = nzb, nz_do3d
-                            local_pf(i,j,k) = u(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-!
-!--                Replace mirrored values at lower surface by real surface
-!--                values
-                   IF ( output_variable == 'u_xz'  .OR.                        &
-                        output_variable == 'u_yz' )  THEN
-                      IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0_wp
-                   ENDIF
-
-
-                CASE ( 'v', 'v_xy', 'v_xz', 'v_yz' )
-                   DO  i = nxl_dvrp, nxr_dvrp+1
-                      DO  j = nys_dvrp, nyn_dvrp+1
-                         DO  k = nzb, nz_do3d
-                            local_pf(i,j,k) = v(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-!
-!--                Replace mirrored values at lower surface by real surface
-!--                values
-                   IF ( output_variable == 'v_xz'  .OR.                        &
-                        output_variable == 'v_yz' )  THEN
-                      IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0_wp
-                   ENDIF
-
-                CASE ( 'w', 'w_xy', 'w_xz', 'w_yz' )
-                   DO  i = nxl_dvrp, nxr_dvrp+1
-                      DO  j = nys_dvrp, nyn_dvrp+1
-                         DO  k = nzb, nz_do3d
-                            local_pf(i,j,k) = w(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-! Averaging for Langmuir circulation
-!                   DO  k = nzb, nz_do3d
-!                      DO  j = nys_dvrp+1, nyn_dvrp
-!                         DO  i = nxl_dvrp, nxr_dvrp+1
-!                            local_pf(i,j,k) = 0.25 * local_pf(i,j-1,k) + &
-!                                              0.50 * local_pf(i,j,k)   + &
-!                                              0.25 * local_pf(i,j+1,k)
-!                         ENDDO
-!                      ENDDO
-!                   ENDDO
-
-                CASE ( 'p', 'p_xy', 'p_xz', 'p_yz' )
-                   DO  i = nxl_dvrp, nxr_dvrp+1
-                      DO  j = nys_dvrp, nyn_dvrp+1
-                         DO  k = nzb, nz_do3d
-                            local_pf(i,j,k) = p(k,j,i)
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                CASE ( 'pt', 'pt_xy', 'pt_xz', 'pt_yz' )
-                   IF ( .NOT. cloud_physics ) THEN
-                      DO  i = nxl_dvrp, nxr_dvrp+1
-                         DO  j = nys_dvrp, nyn_dvrp+1
-                            DO  k = nzb, nz_do3d
-                               local_pf(i,j,k) = pt(k,j,i)
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ELSE
-                      DO  i = nxl_dvrp, nxr_dvrp+1
-                         DO  j = nys_dvrp, nyn_dvrp+1
-                            DO  k = nzb, nz_do3d
-                               local_pf(i,j,k) = pt(k,j,i) + l_d_cp *          &
-                                                 pt_d_t(k) * ql(k,j,i)
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ENDIF
-
-                CASE ( 'q', 'q_xy', 'q_xz', 'q_yz' )
-                   IF ( humidity  .OR.  passive_scalar )  THEN
-                      DO  i = nxl_dvrp, nxr_dvrp+1
-                         DO  j = nys_dvrp, nyn_dvrp+1
-                            DO  k = nzb, nz_do3d
-                               local_pf(i,j,k) = q(k,j,i)
-                            ENDDO
-                         ENDDO
-                      ENDDO            
-                   ELSE                    
-                      message_string = 'if humidity/passive_scalar = '    //   & 
-                            'FALSE output of ' // TRIM( output_variable ) //   &
-                            'is not provided' 
-                      CALL message( 'data_output_dvrp', 'PA0183',&
-                                                                 0, 0, 0, 6, 0 )
-                   ENDIF
-             
-                CASE ( 'ql', 'ql_xy', 'ql_xz', 'ql_yz' )
-                   IF ( cloud_physics  .OR.  cloud_droplets )  THEN
-                      DO  i = nxl_dvrp, nxr_dvrp+1
-                         DO  j = nys_dvrp, nyn_dvrp+1
-                            DO  k = nzb, nz_do3d
-                               local_pf(i,j,k) = ql(k,j,i)
-                            ENDDO
-                         ENDDO
-                      ENDDO
-                   ELSE                     
-                      message_string = 'if cloud_physics = FALSE '       //    & 
-                                  'output of ' // TRIM( output_variable) //    &
-                                  'is not provided' 
-                      CALL message( 'data_output_dvrp', 'PA0184',&
-                                                                 0, 0, 0, 6, 0 )
-                   ENDIF
-
-                CASE ( 'u*_xy' )
-                   DO  i = nxl_dvrp, nxr_dvrp+1
-                      DO  j = nys_dvrp, nyn_dvrp+1
-                         local_pf(i,j,nzb+1) = us(j,i)
-                      ENDDO
-                   ENDDO
-                   slicer_position = zu(nzb+1)
-
-                CASE ( 't*_xy' )
-                   DO  i = nxl_dvrp, nxr_dvrp+1
-                      DO  j = nys_dvrp, nyn_dvrp+1
-                         local_pf(i,j,nzb+1) = ts(j,i)
-                      ENDDO
-                   ENDDO
-                   slicer_position = zu(nzb+1)
-
-
-                CASE DEFAULT
-!
-!--                The DEFAULT case is reached either if output_variable
-!--                contains unsupported variable or if the user has coded a
-!--                special case in the user interface. There, the subroutine
-!--                user_data_output_dvrp checks which of these two conditions
-!--                applies.
-                   CALL user_data_output_dvrp( output_variable, local_pf )
-
-
-             END SELECT
-
-          ELSE
-!
-!--          No overlap of clipping domain with the current subdomain
-             DO  i = nxl_dvrp, nxr_dvrp+1
-                DO  j = nys_dvrp, nyn_dvrp+1
-                   DO  k = nzb, nz_do3d
-                      local_pf(i,j,k) = 0.0_wp
-                   ENDDO
-                ENDDO
-             ENDDO
-
-          ENDIF
-
-          IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
-
-!
-!--          DVRP-Calls for plotting isosurfaces:
-             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'start' )
-
-!
-!--          Definition of isosurface color
-             tmp_r = isosurface_color(1,n_isosurface)
-             tmp_g = isosurface_color(2,n_isosurface)
-             tmp_b = isosurface_color(3,n_isosurface)
-             tmp_t = 0.0_wp
-             CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
-
-!
-!--          Compute and plot isosurface in dvr-format
-             CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp,      &
-                             cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
-
-             c_size_x = vc_size_x;  c_size_y = vc_size_y;  c_size_z = vc_size_z
-             CALL DVRP_CLUSTER_SIZE( m-1, c_size_x, c_size_y, c_size_z )
-
-             c_mode   = vc_mode 
-             CALL DVRP_CLUSTERING_MODE( m-1, c_mode )
-
-             gradient_normals = vc_gradient_normals
-             CALL DVRP_GRADIENTNORMALS( m-1, gradient_normals )
-
-!
-!--          A seperate procedure for setting vc_alpha will be in the next
-!--          version of libDVRP
-             tmp_c_alpha = vc_alpha 
-             CALL DVRP_THRESHOLD( -(m-1)-1, tmp_c_alpha )
-
-             IF ( dvrp_overlap )  THEN
-                tmp_th = threshold(n_isosurface)
-             ELSE
-                tmp_th = 1.0_wp  ! nothing is plotted because array values are 0
-             ENDIF
-
-             CALL DVRP_THRESHOLD( m-1, tmp_th )
-
-             CALL DVRP_VISUALIZE( m-1, 21, dvrp_filecount )
-
-             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'stop' )
-
-          ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
-
-!
-!--          DVRP-Calls for plotting slicers:
-             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'start' )
-
-!
-!--          Material and color definitions
-             tmp_r = 0.0_wp;  tmp_g = 0.0_wp;  tmp_b = 0.0_wp;  tmp_t = 0.0_wp
-             CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
-
-             n_slicer = n_slicer + 1
-
-!
-!--           Using dolorfunction has not been properly tested
-!             islice_dvrp = n_slicer
-!             CALL DVRP_COLORFUNCTION( m-1, DVRP_CM_HLS, 25,                 &
-!                                      slicer_range_limits_dvrp(:,n_slicer), &
-!                                      color_dvrp )
-
-!
-!--          Set interval of values defining the colortable
-             CALL set_slicer_attributes_dvrp( n_slicer )
-
-!
-!--          Create user-defined colortable
-             CALL user_dvrp_coltab( 'slicer', output_variable )
-
-             CALL DVRP_COLORTABLE_HLS( m-1, 1, interval_values_dvrp,           &
-                                       interval_h_dvrp, interval_l_dvrp,       &
-                                       interval_s_dvrp, interval_a_dvrp )
-
-!
-!--          Compute and plot slicer in dvr-format
-             CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp,      &
-                             cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
-             tmp_pos = slicer_position
-             CALL DVRP_SLICER( m-1, section_mode, tmp_pos )
-
-             CALL DVRP_VISUALIZE( m-1, 2, dvrp_filecount )
-
-             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'stop' )
-
-          ENDIF
-
-          DEALLOCATE( local_pf )
-
-       ELSEIF ( mode_dvrp(m)(1:9) == 'pathlines' ) THEN
-
-          ALLOCATE( local_pfi(4,nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
-          DO  i = nxl, nxr+1
-             DO  j = nys, nyn+1
-                DO  k = nzb, nz_do3d
-                   local_pfi(1,i,j,k) = u(k,j,i)
-                   local_pfi(2,i,j,k) = v(k,j,i)
-                   local_pfi(3,i,j,k) = w(k,j,i)
-                   tmp_norm           = SQRT( u(k,j,i) * u(k,j,i) +            &
-                                              v(k,j,i) * v(k,j,i) +            &
-                                              w(k,j,i) * w(k,j,i) )
-                   tmp_alpha          = ACOS( 0.0_wp * u(k,j,i) / tmp_norm +   &
-                                              0.0_wp * v(k,j,i) / tmp_norm -   &
-                                              1.0_wp * w(k,j,i) / tmp_norm )
-                   tmp_alpha_w        = tmp_alpha / pi * 180.0_wp
-                   local_pfi(4,i,j,k) = tmp_alpha_w
-                ENDDO
-             ENDDO
-          ENDDO
-
-          CALL cpu_log( log_point_s(31), 'dvrp_pathlines', 'start' )
-
-          CALL DVRP_DATA( m-1, local_pfi, 4, nx_dvrp, ny_dvrp, nz_dvrp, &
-                          cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
-          CALL DVRP_VISUALIZE( m-1, 20, dvrp_filecount )
-
-          CALL cpu_log( log_point_s(31), 'dvrp_pathlines', 'stop' )
-
-          DEALLOCATE( local_pfi )
-
-       ENDIF
-
-       m = m + 1
-
-    ENDDO
-
-    dvrp_filecount = dvrp_filecount + 1
-
-    CALL cpu_log( log_point(27), 'data_output_dvrp', 'stop' )
-
-#endif
- END SUBROUTINE data_output_dvrp
Index: /palm/trunk/SOURCE/diffusion_e.f90
===================================================================
--- /palm/trunk/SOURCE/diffusion_e.f90	(revision 1873)
+++ /palm/trunk/SOURCE/diffusion_e.f90	(revision 1873)
@@ -0,0 +1,640 @@
+!> @file diffusion_e.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! Adapted for modularization of microphysics
+! 
+! 1831 2016-04-07 13:15:51Z hoffmann 
+! turbulence renamed collision_turbulence
+!
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1374 2014-04-25 12:55:07Z raasch
+! missing variables added to ONLY list
+! rif removed from acc-present-list
+! 
+! 1340 2014-03-25 19:45:13Z kanani
+! REAL constants defined as wp-kind
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1257 2013-11-08 15:18:40Z raasch
+! openacc loop and loop vector clauses removed
+!
+! 1179 2013-06-14 05:57:58Z raasch
+! use_reference renamed use_single_reference_value
+!
+! 1171 2013-05-30 11:27:45Z raasch
+! use_reference-case activated in accelerator version
+!
+! 1128 2013-04-12 06:19:32Z raasch
+! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
+! j_north
+!
+! 1065 2012-11-22 17:42:36Z hoffmann
+! Enabled the claculation of diss in case of turbulence = .TRUE. (parameterized 
+! effects of turbulence on autoconversion and accretion in two-moments cloud 
+! physics scheme). 
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1015 2012-09-27 09:23:24Z raasch
+! accelerator version (*_acc) added,
+! adjustment of mixing length to the Prandtl mixing length at first grid point
+! above ground removed
+!
+! 1010 2012-09-20 07:59:54Z raasch
+! cpp switch __nopointer added for pointer free version
+!
+! 1001 2012-09-13 14:08:46Z raasch
+! most arrays comunicated by module instead of parameter list
+!
+! 825 2012-02-19 03:03:44Z raasch
+! wang_collision_kernel renamed wang_kernel
+!
+! Revision 1.1  1997/09/19 07:40:24  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Diffusion- and dissipation terms for the TKE
+!------------------------------------------------------------------------------!
+ MODULE diffusion_e_mod
+ 
+
+    PRIVATE
+    PUBLIC diffusion_e, diffusion_e_acc
+    
+
+    INTERFACE diffusion_e
+       MODULE PROCEDURE diffusion_e
+       MODULE PROCEDURE diffusion_e_ij
+    END INTERFACE diffusion_e
+ 
+    INTERFACE diffusion_e_acc
+       MODULE PROCEDURE diffusion_e_acc
+    END INTERFACE diffusion_e_acc
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_e( var, var_reference )
+
+       USE arrays_3d,                                                          &
+           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw
+           
+       USE control_parameters,                                                 &
+           ONLY:  atmos_ocean_sign, g, use_single_reference_value, &
+                  wall_adjustment, wall_adjustment_factor
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx2, ddy2
+           
+       USE indices,                                                            &
+           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
+                  nzt
+           
+       USE kinds
+
+       USE microphysics_mod,                                                   &
+           ONLY:  collision_turbulence
+
+       USE particle_attributes,                                                &
+           ONLY:  use_sgs_for_particles, wang_kernel
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i              !< 
+       INTEGER(iwp) ::  j              !< 
+       INTEGER(iwp) ::  k              !< 
+       REAL(wp)     ::  dvar_dz        !< 
+       REAL(wp)     ::  l_stable       !< 
+       REAL(wp)     ::  var_reference  !< 
+
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !< 
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  var  !< 
+#endif
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dissipation  !<
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  l            !<
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  ll           !< 
+ 
+
+!
+!--    This if clause must be outside the k-loop because otherwise
+!--    runtime errors occur with -C hopt on NEC
+       IF ( use_single_reference_value )  THEN
+
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                DO  k = nzb_s_inner(j,i)+1, nzt
+!
+!--                Calculate the mixing length (for dissipation)
+                   dvar_dz = atmos_ocean_sign * &
+                             ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
+                   IF ( dvar_dz > 0.0_wp ) THEN
+                      l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
+                                    SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
+                   ELSE
+                      l_stable = l_grid(k)
+                   ENDIF
+!
+!--                Adjustment of the mixing length
+                   IF ( wall_adjustment )  THEN
+                      l(k,j)  = MIN( wall_adjustment_factor *          &
+                                     ( zu(k) - zw(nzb_s_inner(j,i)) ), &
+                                     l_grid(k), l_stable )
+                      ll(k,j) = MIN( wall_adjustment_factor *          &
+                                     ( zu(k) - zw(nzb_s_inner(j,i)) ), &
+                                     l_grid(k) )
+                   ELSE
+                      l(k,j)  = MIN( l_grid(k), l_stable )
+                      ll(k,j) = l_grid(k)
+                   ENDIF
+
+                ENDDO
+             ENDDO
+
+!
+!--          Calculate the tendency terms
+             DO  j = nys, nyn
+                DO  k = nzb_s_inner(j,i)+1, nzt
+
+                    dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) ) * &
+                                       e(k,j,i) * SQRT( e(k,j,i) ) / l(k,j)
+
+                    tend(k,j,i) = tend(k,j,i)                                  &
+                                        + (                                    &
+                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
+                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
+                                          ) * ddx2                             &
+                                        + (                                    &
+                          ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
+                        - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
+                                          ) * ddy2                             &
+                                        + (                                    &
+               ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
+             - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
+                                          ) * ddzw(k)                          &
+                             - dissipation(k,j)
+
+                ENDDO
+             ENDDO
+
+!
+!--          Store dissipation if needed for calculating the sgs particle
+!--          velocities
+             IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.               &
+                  collision_turbulence )  THEN
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      diss(k,j,i) = dissipation(k,j)
+                   ENDDO
+                ENDDO
+             ENDIF
+
+          ENDDO
+
+       ELSE
+
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                DO  k = nzb_s_inner(j,i)+1, nzt
+!
+!--                Calculate the mixing length (for dissipation)
+                   dvar_dz = atmos_ocean_sign * &
+                             ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
+                   IF ( dvar_dz > 0.0_wp ) THEN
+                      l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
+                                           SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
+                   ELSE
+                      l_stable = l_grid(k)
+                   ENDIF
+!
+!--                Adjustment of the mixing length
+                   IF ( wall_adjustment )  THEN
+                      l(k,j)  = MIN( wall_adjustment_factor *          &
+                                     ( zu(k) - zw(nzb_s_inner(j,i)) ), &
+                                     l_grid(k), l_stable )
+                      ll(k,j) = MIN( wall_adjustment_factor *          &
+                                     ( zu(k) - zw(nzb_s_inner(j,i)) ), &
+                                     l_grid(k) )
+                   ELSE
+                      l(k,j)  = MIN( l_grid(k), l_stable )
+                      ll(k,j) = l_grid(k)
+                   ENDIF
+
+                ENDDO
+             ENDDO
+
+!
+!--          Calculate the tendency terms
+             DO  j = nys, nyn
+                DO  k = nzb_s_inner(j,i)+1, nzt
+
+                    dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) ) * &
+                                             e(k,j,i) * SQRT( e(k,j,i) ) / l(k,j)
+
+                    tend(k,j,i) = tend(k,j,i)                                  &
+                                        + (                                    &
+                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
+                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
+                                          ) * ddx2                             &
+                                        + (                                    &
+                          ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
+                        - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
+                                          ) * ddy2                             &
+                                        + (                                    &
+               ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
+             - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
+                                          ) * ddzw(k)                          &
+                             - dissipation(k,j)
+
+                ENDDO
+             ENDDO
+
+!
+!--          Store dissipation if needed for calculating the sgs particle
+!--          velocities
+             IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.               &
+                  collision_turbulence )  THEN
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      diss(k,j,i) = dissipation(k,j)
+                   ENDDO
+                ENDDO
+             ENDIF
+
+          ENDDO
+
+       ENDIF
+
+!
+!--    Boundary condition for dissipation
+       IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.  &
+            collision_turbulence )  THEN
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                diss(nzb_s_inner(j,i),j,i) = diss(nzb_s_inner(j,i)+1,j,i)
+             ENDDO
+          ENDDO
+       ENDIF
+
+    END SUBROUTINE diffusion_e
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_e_acc( var, var_reference )
+
+       USE arrays_3d,                                                          &
+           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw
+          
+       USE control_parameters,                                                 &
+           ONLY:  atmos_ocean_sign, g, use_single_reference_value,             &
+                  wall_adjustment, wall_adjustment_factor
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx2, ddy2
+           
+       USE indices,                                                            &
+           ONLY:  i_left, i_right, j_north, j_south, nxlg, nxrg, nyng, nysg,   &
+                  nzb, nzb_s_inner, nzt
+           
+       USE kinds
+
+       USE microphysics_mod,                                                   &
+           ONLY:  collision_turbulence
+
+       USE particle_attributes,                                                &
+           ONLY:  use_sgs_for_particles, wang_kernel
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i              !< 
+       INTEGER(iwp) ::  j              !< 
+       INTEGER(iwp) ::  k              !< 
+       REAL(wp)     ::  dissipation    !< 
+       REAL(wp)     ::  dvar_dz        !< 
+       REAL(wp)     ::  l              !< 
+       REAL(wp)     ::  ll             !< 
+       REAL(wp)     ::  l_stable       !< 
+       REAL(wp)     ::  var_reference  !< 
+
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !< 
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  var  !< 
+#endif
+
+
+!
+!--    This if clause must be outside the k-loop because otherwise
+!--    runtime errors occur with -C hopt on NEC
+       IF ( use_single_reference_value )  THEN
+
+          !$acc kernels present( ddzu, ddzw, dd2zu, diss, e, km, l_grid ) &
+          !$acc         present( nzb_s_inner, tend, var, zu, zw )
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+                DO  k = 1, nzt
+
+                   IF ( k > nzb_s_inner(j,i) )  THEN
+!
+!--                   Calculate the mixing length (for dissipation)
+                      dvar_dz = atmos_ocean_sign * &
+                                ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
+                      IF ( dvar_dz > 0.0_wp ) THEN
+                         l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
+                                       SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
+                      ELSE
+                         l_stable = l_grid(k)
+                      ENDIF
+!
+!--                   Adjustment of the mixing length
+                      IF ( wall_adjustment )  THEN
+                         l  = MIN( wall_adjustment_factor *          &
+                                   ( zu(k) - zw(nzb_s_inner(j,i)) ), &
+                                   l_grid(k), l_stable )
+                         ll = MIN( wall_adjustment_factor *          &
+                                   ( zu(k) - zw(nzb_s_inner(j,i)) ), &
+                                   l_grid(k) )
+                      ELSE
+                         l  = MIN( l_grid(k), l_stable )
+                         ll = l_grid(k)
+                      ENDIF
+!
+!--                   Calculate the tendency terms
+                      dissipation = ( 0.19_wp + 0.74_wp * l / ll ) * &
+                                          e(k,j,i) * SQRT( e(k,j,i) ) / l
+
+                      tend(k,j,i) = tend(k,j,i)                                  &
+                                        + (                                    &
+                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
+                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
+                                          ) * ddx2                             &
+                                        + (                                    &
+                          ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
+                        - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
+                                          ) * ddy2                             &
+                                        + (                                    &
+               ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
+             - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
+                                          ) * ddzw(k)                          &
+                                  - dissipation
+
+!
+!--                   Store dissipation if needed for calculating the sgs particle
+!--                   velocities
+                      IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.      &
+                           collision_turbulence )  THEN
+                         diss(k,j,i) = dissipation
+                      ENDIF
+
+                   ENDIF
+
+                ENDDO
+             ENDDO
+          ENDDO
+          !$acc end kernels
+
+       ELSE
+
+          !$acc kernels present( ddzu, ddzw, dd2zu, diss, e, km, l_grid ) &
+          !$acc         present( nzb_s_inner, tend, var, zu, zw )
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+                DO  k = 1, nzt
+
+                   IF ( k > nzb_s_inner(j,i) )  THEN
+!
+!--                   Calculate the mixing length (for dissipation)
+                      dvar_dz = atmos_ocean_sign * &
+                                ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
+                      IF ( dvar_dz > 0.0_wp ) THEN
+                         l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
+                                              SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
+                      ELSE
+                         l_stable = l_grid(k)
+                      ENDIF
+!
+!--                   Adjustment of the mixing length
+                      IF ( wall_adjustment )  THEN
+                         l  = MIN( wall_adjustment_factor *          &
+                                   ( zu(k) - zw(nzb_s_inner(j,i)) ), &
+                                     l_grid(k), l_stable )
+                         ll = MIN( wall_adjustment_factor *          &
+                                   ( zu(k) - zw(nzb_s_inner(j,i)) ), &
+                                   l_grid(k) )
+                      ELSE
+                         l  = MIN( l_grid(k), l_stable )
+                         ll = l_grid(k)
+                      ENDIF
+!
+!--                   Calculate the tendency terms
+                      dissipation = ( 0.19_wp + 0.74_wp * l / ll ) * &
+                                          e(k,j,i) * SQRT( e(k,j,i) ) / l
+
+                      tend(k,j,i) = tend(k,j,i)                                &
+                                        + (                                    &
+                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
+                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
+                                          ) * ddx2                             &
+                                        + (                                    &
+                          ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
+                        - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
+                                          ) * ddy2                             &
+                                        + (                                    &
+               ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
+             - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
+                                          ) * ddzw(k)                          &
+                                  - dissipation
+
+!
+!--                   Store dissipation if needed for calculating the sgs
+!--                   particle  velocities
+                      IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.      &
+                           collision_turbulence )  THEN
+                         diss(k,j,i) = dissipation
+                      ENDIF
+
+                   ENDIF
+
+                ENDDO
+             ENDDO
+          ENDDO
+          !$acc end kernels
+
+       ENDIF
+
+!
+!--    Boundary condition for dissipation
+       IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.                     &
+            collision_turbulence )  THEN
+          !$acc kernels present( diss, nzb_s_inner )
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+                diss(nzb_s_inner(j,i),j,i) = diss(nzb_s_inner(j,i)+1,j,i)
+             ENDDO
+          ENDDO
+          !$acc end kernels
+       ENDIF
+
+    END SUBROUTINE diffusion_e_acc
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_e_ij( i, j, var, var_reference )
+
+       USE arrays_3d,                                                          &
+           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw
+          
+       USE control_parameters,                                                 &
+           ONLY:  atmos_ocean_sign, g, use_single_reference_value,             &
+                  wall_adjustment, wall_adjustment_factor
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx2, ddy2
+           
+       USE indices,                                                            &
+           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
+           
+       USE kinds
+
+       USE microphysics_mod,                                                   &
+           ONLY:  collision_turbulence
+
+       USE particle_attributes,                                                &
+           ONLY:  use_sgs_for_particles, wang_kernel
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i              !< 
+       INTEGER(iwp) ::  j              !< 
+       INTEGER(iwp) ::  k              !< 
+       REAL(wp)     ::  dvar_dz        !< 
+       REAL(wp)     ::  l_stable       !<
+       REAL(wp)     ::  var_reference  !<
+
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  var     !<
+#endif
+       REAL(wp), DIMENSION(nzb+1:nzt) ::  dissipation  !<
+       REAL(wp), DIMENSION(nzb+1:nzt) ::  l            !<
+       REAL(wp), DIMENSION(nzb+1:nzt) ::  ll           !<
+
+
+!
+!--    Calculate the mixing length (for dissipation)
+       DO  k = nzb_s_inner(j,i)+1, nzt
+          dvar_dz = atmos_ocean_sign * &
+                    ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
+          IF ( dvar_dz > 0.0_wp ) THEN
+             IF ( use_single_reference_value )  THEN
+                l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
+                                     SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
+             ELSE
+                l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
+                                     SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
+             ENDIF
+          ELSE
+             l_stable = l_grid(k)
+          ENDIF
+!
+!--       Adjustment of the mixing length
+          IF ( wall_adjustment )  THEN
+             l(k)  = MIN( wall_adjustment_factor *                     &
+                          ( zu(k) - zw(nzb_s_inner(j,i)) ), l_grid(k), &
+                          l_stable )
+             ll(k) = MIN( wall_adjustment_factor *                     &
+                          ( zu(k) - zw(nzb_s_inner(j,i)) ), l_grid(k) )
+          ELSE
+             l(k)  = MIN( l_grid(k), l_stable )
+             ll(k) = l_grid(k)
+          ENDIF
+!
+!--       Calculate the tendency term
+          dissipation(k) = ( 0.19_wp + 0.74_wp * l(k) / ll(k) ) * e(k,j,i) * &
+                                 SQRT( e(k,j,i) ) / l(k)
+
+          tend(k,j,i) = tend(k,j,i)                                           &
+                                       + (                                    &
+                         ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
+                       - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
+                                         ) * ddx2                             &
+                                       + (                                    &
+                         ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
+                       - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
+                                         ) * ddy2                             &
+                                       + (                                    &
+              ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
+            - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
+                                         ) * ddzw(k)                          &
+                                       - dissipation(k)
+
+       ENDDO
+
+!
+!--    Store dissipation if needed for calculating the sgs particle velocities
+       IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.                     &
+            collision_turbulence )  THEN
+          DO  k = nzb_s_inner(j,i)+1, nzt
+             diss(k,j,i) = dissipation(k)
+          ENDDO
+!
+!--       Boundary condition for dissipation
+          diss(nzb_s_inner(j,i),j,i) = diss(nzb_s_inner(j,i)+1,j,i)
+       ENDIF
+
+    END SUBROUTINE diffusion_e_ij
+
+ END MODULE diffusion_e_mod
Index: lm/trunk/SOURCE/diffusion_e_mod.f90
===================================================================
--- /palm/trunk/SOURCE/diffusion_e_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,639 +1,0 @@
-!> @file diffusion_e_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! Adapted for modularization of microphysics
-! 
-! 1831 2016-04-07 13:15:51Z hoffmann 
-! turbulence renamed collision_turbulence
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1374 2014-04-25 12:55:07Z raasch
-! missing variables added to ONLY list
-! rif removed from acc-present-list
-! 
-! 1340 2014-03-25 19:45:13Z kanani
-! REAL constants defined as wp-kind
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1257 2013-11-08 15:18:40Z raasch
-! openacc loop and loop vector clauses removed
-!
-! 1179 2013-06-14 05:57:58Z raasch
-! use_reference renamed use_single_reference_value
-!
-! 1171 2013-05-30 11:27:45Z raasch
-! use_reference-case activated in accelerator version
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1065 2012-11-22 17:42:36Z hoffmann
-! Enabled the claculation of diss in case of turbulence = .TRUE. (parameterized 
-! effects of turbulence on autoconversion and accretion in two-moments cloud 
-! physics scheme). 
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! accelerator version (*_acc) added,
-! adjustment of mixing length to the Prandtl mixing length at first grid point
-! above ground removed
-!
-! 1010 2012-09-20 07:59:54Z raasch
-! cpp switch __nopointer added for pointer free version
-!
-! 1001 2012-09-13 14:08:46Z raasch
-! most arrays comunicated by module instead of parameter list
-!
-! 825 2012-02-19 03:03:44Z raasch
-! wang_collision_kernel renamed wang_kernel
-!
-! Revision 1.1  1997/09/19 07:40:24  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Diffusion- and dissipation terms for the TKE
-!------------------------------------------------------------------------------!
- MODULE diffusion_e_mod
- 
-
-    PRIVATE
-    PUBLIC diffusion_e, diffusion_e_acc
-    
-
-    INTERFACE diffusion_e
-       MODULE PROCEDURE diffusion_e
-       MODULE PROCEDURE diffusion_e_ij
-    END INTERFACE diffusion_e
- 
-    INTERFACE diffusion_e_acc
-       MODULE PROCEDURE diffusion_e_acc
-    END INTERFACE diffusion_e_acc
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_e( var, var_reference )
-
-       USE arrays_3d,                                                          &
-           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw
-           
-       USE control_parameters,                                                 &
-           ONLY:  atmos_ocean_sign, g, use_single_reference_value, &
-                  wall_adjustment, wall_adjustment_factor
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx2, ddy2
-           
-       USE indices,                                                            &
-           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_s_inner,&
-                  nzt
-           
-       USE kinds
-
-       USE microphysics_mod,                                                   &
-           ONLY:  collision_turbulence
-
-       USE particle_attributes,                                                &
-           ONLY:  use_sgs_for_particles, wang_kernel
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i              !< 
-       INTEGER(iwp) ::  j              !< 
-       INTEGER(iwp) ::  k              !< 
-       REAL(wp)     ::  dvar_dz        !< 
-       REAL(wp)     ::  l_stable       !< 
-       REAL(wp)     ::  var_reference  !< 
-
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !< 
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  var  !< 
-#endif
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dissipation  !<
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  l            !<
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  ll           !< 
- 
-
-!
-!--    This if clause must be outside the k-loop because otherwise
-!--    runtime errors occur with -C hopt on NEC
-       IF ( use_single_reference_value )  THEN
-
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb_s_inner(j,i)+1, nzt
-!
-!--                Calculate the mixing length (for dissipation)
-                   dvar_dz = atmos_ocean_sign * &
-                             ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-                   IF ( dvar_dz > 0.0_wp ) THEN
-                      l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
-                                    SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
-                   ELSE
-                      l_stable = l_grid(k)
-                   ENDIF
-!
-!--                Adjustment of the mixing length
-                   IF ( wall_adjustment )  THEN
-                      l(k,j)  = MIN( wall_adjustment_factor *          &
-                                     ( zu(k) - zw(nzb_s_inner(j,i)) ), &
-                                     l_grid(k), l_stable )
-                      ll(k,j) = MIN( wall_adjustment_factor *          &
-                                     ( zu(k) - zw(nzb_s_inner(j,i)) ), &
-                                     l_grid(k) )
-                   ELSE
-                      l(k,j)  = MIN( l_grid(k), l_stable )
-                      ll(k,j) = l_grid(k)
-                   ENDIF
-
-                ENDDO
-             ENDDO
-
-!
-!--          Calculate the tendency terms
-             DO  j = nys, nyn
-                DO  k = nzb_s_inner(j,i)+1, nzt
-
-                    dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) ) * &
-                                       e(k,j,i) * SQRT( e(k,j,i) ) / l(k,j)
-
-                    tend(k,j,i) = tend(k,j,i)                                  &
-                                        + (                                    &
-                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
-                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
-                                          ) * ddx2                             &
-                                        + (                                    &
-                          ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
-                        - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
-                                          ) * ddy2                             &
-                                        + (                                    &
-               ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
-             - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
-                                          ) * ddzw(k)                          &
-                             - dissipation(k,j)
-
-                ENDDO
-             ENDDO
-
-!
-!--          Store dissipation if needed for calculating the sgs particle
-!--          velocities
-             IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.               &
-                  collision_turbulence )  THEN
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      diss(k,j,i) = dissipation(k,j)
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDDO
-
-       ELSE
-
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb_s_inner(j,i)+1, nzt
-!
-!--                Calculate the mixing length (for dissipation)
-                   dvar_dz = atmos_ocean_sign * &
-                             ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-                   IF ( dvar_dz > 0.0_wp ) THEN
-                      l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
-                                           SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
-                   ELSE
-                      l_stable = l_grid(k)
-                   ENDIF
-!
-!--                Adjustment of the mixing length
-                   IF ( wall_adjustment )  THEN
-                      l(k,j)  = MIN( wall_adjustment_factor *          &
-                                     ( zu(k) - zw(nzb_s_inner(j,i)) ), &
-                                     l_grid(k), l_stable )
-                      ll(k,j) = MIN( wall_adjustment_factor *          &
-                                     ( zu(k) - zw(nzb_s_inner(j,i)) ), &
-                                     l_grid(k) )
-                   ELSE
-                      l(k,j)  = MIN( l_grid(k), l_stable )
-                      ll(k,j) = l_grid(k)
-                   ENDIF
-
-                ENDDO
-             ENDDO
-
-!
-!--          Calculate the tendency terms
-             DO  j = nys, nyn
-                DO  k = nzb_s_inner(j,i)+1, nzt
-
-                    dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) ) * &
-                                             e(k,j,i) * SQRT( e(k,j,i) ) / l(k,j)
-
-                    tend(k,j,i) = tend(k,j,i)                                  &
-                                        + (                                    &
-                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
-                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
-                                          ) * ddx2                             &
-                                        + (                                    &
-                          ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
-                        - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
-                                          ) * ddy2                             &
-                                        + (                                    &
-               ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
-             - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
-                                          ) * ddzw(k)                          &
-                             - dissipation(k,j)
-
-                ENDDO
-             ENDDO
-
-!
-!--          Store dissipation if needed for calculating the sgs particle
-!--          velocities
-             IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.               &
-                  collision_turbulence )  THEN
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      diss(k,j,i) = dissipation(k,j)
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDDO
-
-       ENDIF
-
-!
-!--    Boundary condition for dissipation
-       IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.  &
-            collision_turbulence )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                diss(nzb_s_inner(j,i),j,i) = diss(nzb_s_inner(j,i)+1,j,i)
-             ENDDO
-          ENDDO
-       ENDIF
-
-    END SUBROUTINE diffusion_e
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_e_acc( var, var_reference )
-
-       USE arrays_3d,                                                          &
-           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw
-          
-       USE control_parameters,                                                 &
-           ONLY:  atmos_ocean_sign, g, use_single_reference_value,             &
-                  wall_adjustment, wall_adjustment_factor
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx2, ddy2
-           
-       USE indices,                                                            &
-           ONLY:  i_left, i_right, j_north, j_south, nxlg, nxrg, nyng, nysg,   &
-                  nzb, nzb_s_inner, nzt
-           
-       USE kinds
-
-       USE microphysics_mod,                                                   &
-           ONLY:  collision_turbulence
-
-       USE particle_attributes,                                                &
-           ONLY:  use_sgs_for_particles, wang_kernel
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i              !< 
-       INTEGER(iwp) ::  j              !< 
-       INTEGER(iwp) ::  k              !< 
-       REAL(wp)     ::  dissipation    !< 
-       REAL(wp)     ::  dvar_dz        !< 
-       REAL(wp)     ::  l              !< 
-       REAL(wp)     ::  ll             !< 
-       REAL(wp)     ::  l_stable       !< 
-       REAL(wp)     ::  var_reference  !< 
-
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !< 
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  var  !< 
-#endif
-
-
-!
-!--    This if clause must be outside the k-loop because otherwise
-!--    runtime errors occur with -C hopt on NEC
-       IF ( use_single_reference_value )  THEN
-
-          !$acc kernels present( ddzu, ddzw, dd2zu, diss, e, km, l_grid ) &
-          !$acc         present( nzb_s_inner, tend, var, zu, zw )
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-                DO  k = 1, nzt
-
-                   IF ( k > nzb_s_inner(j,i) )  THEN
-!
-!--                   Calculate the mixing length (for dissipation)
-                      dvar_dz = atmos_ocean_sign * &
-                                ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-                      IF ( dvar_dz > 0.0_wp ) THEN
-                         l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
-                                       SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
-                      ELSE
-                         l_stable = l_grid(k)
-                      ENDIF
-!
-!--                   Adjustment of the mixing length
-                      IF ( wall_adjustment )  THEN
-                         l  = MIN( wall_adjustment_factor *          &
-                                   ( zu(k) - zw(nzb_s_inner(j,i)) ), &
-                                   l_grid(k), l_stable )
-                         ll = MIN( wall_adjustment_factor *          &
-                                   ( zu(k) - zw(nzb_s_inner(j,i)) ), &
-                                   l_grid(k) )
-                      ELSE
-                         l  = MIN( l_grid(k), l_stable )
-                         ll = l_grid(k)
-                      ENDIF
-!
-!--                   Calculate the tendency terms
-                      dissipation = ( 0.19_wp + 0.74_wp * l / ll ) * &
-                                          e(k,j,i) * SQRT( e(k,j,i) ) / l
-
-                      tend(k,j,i) = tend(k,j,i)                                  &
-                                        + (                                    &
-                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
-                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
-                                          ) * ddx2                             &
-                                        + (                                    &
-                          ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
-                        - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
-                                          ) * ddy2                             &
-                                        + (                                    &
-               ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
-             - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
-                                          ) * ddzw(k)                          &
-                                  - dissipation
-
-!
-!--                   Store dissipation if needed for calculating the sgs particle
-!--                   velocities
-                      IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.      &
-                           collision_turbulence )  THEN
-                         diss(k,j,i) = dissipation
-                      ENDIF
-
-                   ENDIF
-
-                ENDDO
-             ENDDO
-          ENDDO
-          !$acc end kernels
-
-       ELSE
-
-          !$acc kernels present( ddzu, ddzw, dd2zu, diss, e, km, l_grid ) &
-          !$acc         present( nzb_s_inner, tend, var, zu, zw )
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-                DO  k = 1, nzt
-
-                   IF ( k > nzb_s_inner(j,i) )  THEN
-!
-!--                   Calculate the mixing length (for dissipation)
-                      dvar_dz = atmos_ocean_sign * &
-                                ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-                      IF ( dvar_dz > 0.0_wp ) THEN
-                         l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
-                                              SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
-                      ELSE
-                         l_stable = l_grid(k)
-                      ENDIF
-!
-!--                   Adjustment of the mixing length
-                      IF ( wall_adjustment )  THEN
-                         l  = MIN( wall_adjustment_factor *          &
-                                   ( zu(k) - zw(nzb_s_inner(j,i)) ), &
-                                     l_grid(k), l_stable )
-                         ll = MIN( wall_adjustment_factor *          &
-                                   ( zu(k) - zw(nzb_s_inner(j,i)) ), &
-                                   l_grid(k) )
-                      ELSE
-                         l  = MIN( l_grid(k), l_stable )
-                         ll = l_grid(k)
-                      ENDIF
-!
-!--                   Calculate the tendency terms
-                      dissipation = ( 0.19_wp + 0.74_wp * l / ll ) * &
-                                          e(k,j,i) * SQRT( e(k,j,i) ) / l
-
-                      tend(k,j,i) = tend(k,j,i)                                &
-                                        + (                                    &
-                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
-                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
-                                          ) * ddx2                             &
-                                        + (                                    &
-                          ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
-                        - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
-                                          ) * ddy2                             &
-                                        + (                                    &
-               ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
-             - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
-                                          ) * ddzw(k)                          &
-                                  - dissipation
-
-!
-!--                   Store dissipation if needed for calculating the sgs
-!--                   particle  velocities
-                      IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.      &
-                           collision_turbulence )  THEN
-                         diss(k,j,i) = dissipation
-                      ENDIF
-
-                   ENDIF
-
-                ENDDO
-             ENDDO
-          ENDDO
-          !$acc end kernels
-
-       ENDIF
-
-!
-!--    Boundary condition for dissipation
-       IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.                     &
-            collision_turbulence )  THEN
-          !$acc kernels present( diss, nzb_s_inner )
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-                diss(nzb_s_inner(j,i),j,i) = diss(nzb_s_inner(j,i)+1,j,i)
-             ENDDO
-          ENDDO
-          !$acc end kernels
-       ENDIF
-
-    END SUBROUTINE diffusion_e_acc
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_e_ij( i, j, var, var_reference )
-
-       USE arrays_3d,                                                          &
-           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw
-          
-       USE control_parameters,                                                 &
-           ONLY:  atmos_ocean_sign, g, use_single_reference_value,             &
-                  wall_adjustment, wall_adjustment_factor
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx2, ddy2
-           
-       USE indices,                                                            &
-           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner, nzt
-           
-       USE kinds
-
-       USE microphysics_mod,                                                   &
-           ONLY:  collision_turbulence
-
-       USE particle_attributes,                                                &
-           ONLY:  use_sgs_for_particles, wang_kernel
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i              !< 
-       INTEGER(iwp) ::  j              !< 
-       INTEGER(iwp) ::  k              !< 
-       REAL(wp)     ::  dvar_dz        !< 
-       REAL(wp)     ::  l_stable       !<
-       REAL(wp)     ::  var_reference  !<
-
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  var     !<
-#endif
-       REAL(wp), DIMENSION(nzb+1:nzt) ::  dissipation  !<
-       REAL(wp), DIMENSION(nzb+1:nzt) ::  l            !<
-       REAL(wp), DIMENSION(nzb+1:nzt) ::  ll           !<
-
-
-!
-!--    Calculate the mixing length (for dissipation)
-       DO  k = nzb_s_inner(j,i)+1, nzt
-          dvar_dz = atmos_ocean_sign * &
-                    ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-          IF ( dvar_dz > 0.0_wp ) THEN
-             IF ( use_single_reference_value )  THEN
-                l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
-                                     SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
-             ELSE
-                l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
-                                     SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
-             ENDIF
-          ELSE
-             l_stable = l_grid(k)
-          ENDIF
-!
-!--       Adjustment of the mixing length
-          IF ( wall_adjustment )  THEN
-             l(k)  = MIN( wall_adjustment_factor *                     &
-                          ( zu(k) - zw(nzb_s_inner(j,i)) ), l_grid(k), &
-                          l_stable )
-             ll(k) = MIN( wall_adjustment_factor *                     &
-                          ( zu(k) - zw(nzb_s_inner(j,i)) ), l_grid(k) )
-          ELSE
-             l(k)  = MIN( l_grid(k), l_stable )
-             ll(k) = l_grid(k)
-          ENDIF
-!
-!--       Calculate the tendency term
-          dissipation(k) = ( 0.19_wp + 0.74_wp * l(k) / ll(k) ) * e(k,j,i) * &
-                                 SQRT( e(k,j,i) ) / l(k)
-
-          tend(k,j,i) = tend(k,j,i)                                           &
-                                       + (                                    &
-                         ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
-                       - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
-                                         ) * ddx2                             &
-                                       + (                                    &
-                         ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) )  &
-                       - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) )  &
-                                         ) * ddy2                             &
-                                       + (                                    &
-              ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
-            - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k)   &
-                                         ) * ddzw(k)                          &
-                                       - dissipation(k)
-
-       ENDDO
-
-!
-!--    Store dissipation if needed for calculating the sgs particle velocities
-       IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.                     &
-            collision_turbulence )  THEN
-          DO  k = nzb_s_inner(j,i)+1, nzt
-             diss(k,j,i) = dissipation(k)
-          ENDDO
-!
-!--       Boundary condition for dissipation
-          diss(nzb_s_inner(j,i),j,i) = diss(nzb_s_inner(j,i)+1,j,i)
-       ENDIF
-
-    END SUBROUTINE diffusion_e_ij
-
- END MODULE diffusion_e_mod
Index: /palm/trunk/SOURCE/diffusion_s.f90
===================================================================
--- /palm/trunk/SOURCE/diffusion_s.f90	(revision 1873)
+++ /palm/trunk/SOURCE/diffusion_s.f90	(revision 1873)
@@ -0,0 +1,475 @@
+!> @file diffusion_s.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1691 2015-10-26 16:17:44Z maronga
+! Formatting corrections.
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1374 2014-04-25 12:55:07Z raasch
+! missing variables added to ONLY list
+! 
+! 1340 2014-03-25 19:45:13Z kanani
+! REAL constants defined as wp-kind
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+! 
+! 1257 2013-11-08 15:18:40Z raasch
+! openacc loop and loop vector clauses removed
+!
+! 1128 2013-04-12 06:19:32Z raasch
+! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
+! j_north
+!
+! 1092 2013-02-02 11:24:22Z raasch
+! unused variables removed
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1015 2012-09-27 09:23:24Z raasch
+! accelerator version (*_acc) added
+!
+! 1010 2012-09-20 07:59:54Z raasch
+! cpp switch __nopointer added for pointer free version
+!
+! 1001 2012-09-13 14:08:46Z raasch
+! some arrays comunicated by module instead of parameter list
+!
+! Revision 1.1  2000/04/13 14:54:02  schroeter
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Diffusion term of scalar quantities (temperature and water content)
+!------------------------------------------------------------------------------!
+ MODULE diffusion_s_mod
+ 
+
+    PRIVATE
+    PUBLIC diffusion_s, diffusion_s_acc
+
+    INTERFACE diffusion_s
+       MODULE PROCEDURE diffusion_s
+       MODULE PROCEDURE diffusion_s_ij
+    END INTERFACE diffusion_s
+
+    INTERFACE diffusion_s_acc
+       MODULE PROCEDURE diffusion_s_acc
+    END INTERFACE diffusion_s_acc
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_s( s, s_flux_b, s_flux_t, wall_s_flux )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, ddzw, kh, tend
+       
+       USE control_parameters,                                                 & 
+           ONLY: use_surface_fluxes, use_top_fluxes
+       
+       USE grid_variables,                                                     &
+           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
+       
+       USE indices,                                                            &
+           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb,             &
+                  nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, nzt, nzt_diff
+       
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i                 !< 
+       INTEGER(iwp) ::  j                 !< 
+       INTEGER(iwp) ::  k                 !< 
+       REAL(wp)     ::  wall_s_flux(0:4)  !< 
+       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t !<
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s  !< 
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !< 
+#endif
+
+       DO  i = nxl, nxr
+          DO  j = nys,nyn
+!
+!--          Compute horizontal diffusion
+             DO  k = nzb_s_outer(j,i)+1, nzt
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                                          + 0.5_wp * (                         &
+                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
+                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
+                                                     ) * ddx2                  &
+                                          + 0.5_wp * (                         &
+                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
+                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
+                                                     ) * ddy2
+             ENDDO
+
+!
+!--          Apply prescribed horizontal wall heatflux where necessary
+             IF ( ( wall_w_x(j,i) /= 0.0_wp ) .OR. ( wall_w_y(j,i) /= 0.0_wp ) &
+                )  THEN
+                DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                                + ( fwxp(j,i) * 0.5_wp *       &
+                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
+                        + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1)              &
+                                                   -fwxm(j,i) * 0.5_wp *       &
+                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
+                        + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2)              &
+                                                  ) * ddx2                     &
+                                                + ( fwyp(j,i) * 0.5_wp *       &
+                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
+                        + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3)              &
+                                                   -fwym(j,i) * 0.5_wp *       &
+                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
+                        + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4)              &
+                                                  ) * ddy2
+                ENDDO
+             ENDIF
+
+!
+!--          Compute vertical diffusion. In case that surface fluxes have been
+!--          prescribed or computed at bottom and/or top, index k starts/ends at
+!--          nzb+2 or nzt-1, respectively.
+             DO  k = nzb_diff_s_inner(j,i), nzt_diff
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                                       + 0.5_wp * (                            &
+            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
+          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
+                                                  ) * ddzw(k)
+             ENDDO
+
+!
+!--          Vertical diffusion at the first computational gridpoint along
+!--          z-direction
+             IF ( use_surface_fluxes )  THEN
+
+                k = nzb_s_inner(j,i)+1
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                                       + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )  &
+                                                  * ( s(k+1,j,i)-s(k,j,i) )    &
+                                                  * ddzu(k+1)                  &
+                                           + s_flux_b(j,i)                     &
+                                         ) * ddzw(k)
+
+             ENDIF
+
+!
+!--          Vertical diffusion at the last computational gridpoint along
+!--          z-direction
+             IF ( use_top_fluxes )  THEN
+
+                k = nzt
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                                       + ( - s_flux_t(j,i)                     &
+                                           - 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )&
+                                                    * ( s(k,j,i)-s(k-1,j,i) )  &
+                                                    * ddzu(k)                  &
+                                         ) * ddzw(k)
+
+             ENDIF
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE diffusion_s
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_s_acc( s, s_flux_b, s_flux_t, wall_s_flux )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, ddzw, kh, tend
+           
+       USE control_parameters,                                                 & 
+           ONLY: use_surface_fluxes, use_top_fluxes
+       
+       USE grid_variables,                                                     &
+           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
+       
+       USE indices, &
+           ONLY: i_left, i_right, j_north, j_south, nxlg, nxrg, nyng, nysg,    &
+                 nzb, nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, nzt, nzt_diff
+           
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i                 !< 
+       INTEGER(iwp) ::  j                 !< 
+       INTEGER(iwp) ::  k                 !< 
+       REAL(wp)     ::  wall_s_flux(0:4)  !< 
+       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b !< 
+       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_t !< 
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s  !<
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !<
+#endif
+
+       !$acc kernels present( ddzu, ddzw, fwxm, fwxp, fwym, fwyp, kh )        &
+       !$acc         present( nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, s ) &
+       !$acc         present( s_flux_b, s_flux_t, tend, wall_s_flux )         &
+       !$acc         present( wall_w_x, wall_w_y )
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+!
+!--          Compute horizontal diffusion
+             DO  k = 1, nzt
+                IF ( k > nzb_s_outer(j,i) )  THEN
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                          + 0.5_wp * (                         &
+                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
+                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
+                                                     ) * ddx2                  &
+                                          + 0.5_wp * (                         &
+                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
+                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
+                                                     ) * ddy2
+                ENDIF
+             ENDDO
+
+!
+!--          Apply prescribed horizontal wall heatflux where necessary
+             DO  k = 1, nzt
+                IF ( k > nzb_s_inner(j,i)  .AND.  k <= nzb_s_outer(j,i)  .AND. &
+                     ( wall_w_x(j,i) /= 0.0_wp  .OR.  wall_w_y(j,i) /= 0.0_wp ) )    &
+                THEN
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                                + ( fwxp(j,i) * 0.5_wp *       &
+                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
+                        + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1)              &
+                                                   -fwxm(j,i) * 0.5_wp *       &
+                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
+                        + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2)              &
+                                                  ) * ddx2                     &
+                                                + ( fwyp(j,i) * 0.5_wp *       &
+                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
+                        + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3)              &
+                                                   -fwym(j,i) * 0.5_wp *       &
+                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
+                        + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4)              &
+                                                  ) * ddy2
+                ENDIF
+             ENDDO
+
+!
+!--          Compute vertical diffusion. In case that surface fluxes have been
+!--          prescribed or computed at bottom and/or top, index k starts/ends at
+!--          nzb+2 or nzt-1, respectively.
+             DO  k = 1, nzt_diff
+                IF ( k >= nzb_diff_s_inner(j,i) )  THEN
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                       + 0.5_wp * (                            &
+            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
+          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
+                                                  ) * ddzw(k)
+                ENDIF
+             ENDDO
+
+!
+!--          Vertical diffusion at the first computational gridpoint along
+!--          z-direction
+             DO  k = 1, nzt
+                IF ( use_surface_fluxes  .AND.  k == nzb_s_inner(j,i)+1 )  THEN
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                          + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )&
+                                                     * ( s(k+1,j,i)-s(k,j,i) ) &
+                                                     * ddzu(k+1)               &
+                                              + s_flux_b(j,i)                  &
+                                            ) * ddzw(k)
+                ENDIF
+
+!
+!--             Vertical diffusion at the last computational gridpoint along
+!--             z-direction
+                IF ( use_top_fluxes  .AND.  k == nzt )  THEN
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                          + ( - s_flux_t(j,i)                  &
+                                              - 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )&
+                                                       * ( s(k,j,i)-s(k-1,j,i) )  &
+                                                       * ddzu(k)                  &
+                                            ) * ddzw(k)
+                ENDIF
+             ENDDO
+
+          ENDDO
+       ENDDO
+       !$acc end kernels
+
+    END SUBROUTINE diffusion_s_acc
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, ddzw, kh, tend
+           
+       USE control_parameters,                                                 & 
+           ONLY: use_surface_fluxes, use_top_fluxes
+       
+       USE grid_variables,                                                     &
+           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
+       
+       USE indices,                                                            &
+           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_diff_s_inner, nzb_s_inner,  &
+                  nzb_s_outer, nzt, nzt_diff
+       
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i                 !< 
+       INTEGER(iwp) ::  j                 !< 
+       INTEGER(iwp) ::  k                 !< 
+       REAL(wp)     ::  wall_s_flux(0:4)  !< 
+       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b  !< 
+       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_t  !< 
+#if defined( __nopointer )
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s !< 
+#else
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !< 
+#endif
+
+!
+!--    Compute horizontal diffusion
+       DO  k = nzb_s_outer(j,i)+1, nzt
+
+          tend(k,j,i) = tend(k,j,i)                                            &
+                                          + 0.5_wp * (                         &
+                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
+                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
+                                                     ) * ddx2                  &
+                                          + 0.5_wp * (                         &
+                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
+                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
+                                                     ) * ddy2
+       ENDDO
+
+!
+!--    Apply prescribed horizontal wall heatflux where necessary
+       IF ( ( wall_w_x(j,i) /= 0.0_wp ) .OR. ( wall_w_y(j,i) /= 0.0_wp ) )     &
+       THEN
+          DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
+
+             tend(k,j,i) = tend(k,j,i)                                         &
+                                                + ( fwxp(j,i) * 0.5_wp *       &
+                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
+                        + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1)              &
+                                                   -fwxm(j,i) * 0.5_wp *       &
+                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
+                        + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2)              &
+                                                  ) * ddx2                     &
+                                                + ( fwyp(j,i) * 0.5_wp *       &
+                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
+                        + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3)              &
+                                                   -fwym(j,i) * 0.5_wp *       &
+                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
+                        + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4)              &
+                                                  ) * ddy2
+          ENDDO
+       ENDIF
+
+!
+!--    Compute vertical diffusion. In case that surface fluxes have been
+!--    prescribed or computed at bottom and/or top, index k starts/ends at
+!--    nzb+2 or nzt-1, respectively.
+       DO  k = nzb_diff_s_inner(j,i), nzt_diff
+
+          tend(k,j,i) = tend(k,j,i)                                            &
+                                       + 0.5_wp * (                            &
+            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
+          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
+                                                  ) * ddzw(k)
+       ENDDO
+
+!
+!--    Vertical diffusion at the first computational gridpoint along z-direction
+       IF ( use_surface_fluxes )  THEN
+
+          k = nzb_s_inner(j,i)+1
+
+          tend(k,j,i) = tend(k,j,i) + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )     &
+                                               * ( s(k+1,j,i)-s(k,j,i) )       &
+                                               * ddzu(k+1)                     &
+                                        + s_flux_b(j,i)                        &
+                                      ) * ddzw(k)
+
+       ENDIF
+
+!
+!--    Vertical diffusion at the last computational gridpoint along z-direction
+       IF ( use_top_fluxes )  THEN
+
+          k = nzt
+
+          tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i)                        &
+                                      - 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )     &
+                                               * ( s(k,j,i)-s(k-1,j,i) )       &
+                                               * ddzu(k)                       &
+                                      ) * ddzw(k)
+
+       ENDIF
+
+    END SUBROUTINE diffusion_s_ij
+
+ END MODULE diffusion_s_mod
Index: lm/trunk/SOURCE/diffusion_s_mod.f90
===================================================================
--- /palm/trunk/SOURCE/diffusion_s_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,474 +1,0 @@
-!> @file diffusion_s_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1691 2015-10-26 16:17:44Z maronga
-! Formatting corrections.
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1374 2014-04-25 12:55:07Z raasch
-! missing variables added to ONLY list
-! 
-! 1340 2014-03-25 19:45:13Z kanani
-! REAL constants defined as wp-kind
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-! 
-! 1257 2013-11-08 15:18:40Z raasch
-! openacc loop and loop vector clauses removed
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1092 2013-02-02 11:24:22Z raasch
-! unused variables removed
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! accelerator version (*_acc) added
-!
-! 1010 2012-09-20 07:59:54Z raasch
-! cpp switch __nopointer added for pointer free version
-!
-! 1001 2012-09-13 14:08:46Z raasch
-! some arrays comunicated by module instead of parameter list
-!
-! Revision 1.1  2000/04/13 14:54:02  schroeter
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Diffusion term of scalar quantities (temperature and water content)
-!------------------------------------------------------------------------------!
- MODULE diffusion_s_mod
- 
-
-    PRIVATE
-    PUBLIC diffusion_s, diffusion_s_acc
-
-    INTERFACE diffusion_s
-       MODULE PROCEDURE diffusion_s
-       MODULE PROCEDURE diffusion_s_ij
-    END INTERFACE diffusion_s
-
-    INTERFACE diffusion_s_acc
-       MODULE PROCEDURE diffusion_s_acc
-    END INTERFACE diffusion_s_acc
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_s( s, s_flux_b, s_flux_t, wall_s_flux )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, ddzw, kh, tend
-       
-       USE control_parameters,                                                 & 
-           ONLY: use_surface_fluxes, use_top_fluxes
-       
-       USE grid_variables,                                                     &
-           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
-       
-       USE indices,                                                            &
-           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb,             &
-                  nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, nzt, nzt_diff
-       
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< 
-       INTEGER(iwp) ::  j                 !< 
-       INTEGER(iwp) ::  k                 !< 
-       REAL(wp)     ::  wall_s_flux(0:4)  !< 
-       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t !<
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s  !< 
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !< 
-#endif
-
-       DO  i = nxl, nxr
-          DO  j = nys,nyn
-!
-!--          Compute horizontal diffusion
-             DO  k = nzb_s_outer(j,i)+1, nzt
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                                          + 0.5_wp * (                         &
-                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
-                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
-                                                     ) * ddx2                  &
-                                          + 0.5_wp * (                         &
-                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
-                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
-                                                     ) * ddy2
-             ENDDO
-
-!
-!--          Apply prescribed horizontal wall heatflux where necessary
-             IF ( ( wall_w_x(j,i) /= 0.0_wp ) .OR. ( wall_w_y(j,i) /= 0.0_wp ) &
-                )  THEN
-                DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
-
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                                + ( fwxp(j,i) * 0.5_wp *       &
-                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
-                        + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1)              &
-                                                   -fwxm(j,i) * 0.5_wp *       &
-                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
-                        + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2)              &
-                                                  ) * ddx2                     &
-                                                + ( fwyp(j,i) * 0.5_wp *       &
-                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
-                        + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3)              &
-                                                   -fwym(j,i) * 0.5_wp *       &
-                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
-                        + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4)              &
-                                                  ) * ddy2
-                ENDDO
-             ENDIF
-
-!
-!--          Compute vertical diffusion. In case that surface fluxes have been
-!--          prescribed or computed at bottom and/or top, index k starts/ends at
-!--          nzb+2 or nzt-1, respectively.
-             DO  k = nzb_diff_s_inner(j,i), nzt_diff
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                                       + 0.5_wp * (                            &
-            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
-          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
-                                                  ) * ddzw(k)
-             ENDDO
-
-!
-!--          Vertical diffusion at the first computational gridpoint along
-!--          z-direction
-             IF ( use_surface_fluxes )  THEN
-
-                k = nzb_s_inner(j,i)+1
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                                       + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )  &
-                                                  * ( s(k+1,j,i)-s(k,j,i) )    &
-                                                  * ddzu(k+1)                  &
-                                           + s_flux_b(j,i)                     &
-                                         ) * ddzw(k)
-
-             ENDIF
-
-!
-!--          Vertical diffusion at the last computational gridpoint along
-!--          z-direction
-             IF ( use_top_fluxes )  THEN
-
-                k = nzt
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                                       + ( - s_flux_t(j,i)                     &
-                                           - 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )&
-                                                    * ( s(k,j,i)-s(k-1,j,i) )  &
-                                                    * ddzu(k)                  &
-                                         ) * ddzw(k)
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE diffusion_s
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_s_acc( s, s_flux_b, s_flux_t, wall_s_flux )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, ddzw, kh, tend
-           
-       USE control_parameters,                                                 & 
-           ONLY: use_surface_fluxes, use_top_fluxes
-       
-       USE grid_variables,                                                     &
-           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
-       
-       USE indices, &
-           ONLY: i_left, i_right, j_north, j_south, nxlg, nxrg, nyng, nysg,    &
-                 nzb, nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, nzt, nzt_diff
-           
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< 
-       INTEGER(iwp) ::  j                 !< 
-       INTEGER(iwp) ::  k                 !< 
-       REAL(wp)     ::  wall_s_flux(0:4)  !< 
-       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b !< 
-       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_t !< 
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s  !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !<
-#endif
-
-       !$acc kernels present( ddzu, ddzw, fwxm, fwxp, fwym, fwyp, kh )        &
-       !$acc         present( nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, s ) &
-       !$acc         present( s_flux_b, s_flux_t, tend, wall_s_flux )         &
-       !$acc         present( wall_w_x, wall_w_y )
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-!
-!--          Compute horizontal diffusion
-             DO  k = 1, nzt
-                IF ( k > nzb_s_outer(j,i) )  THEN
-
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                          + 0.5_wp * (                         &
-                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
-                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
-                                                     ) * ddx2                  &
-                                          + 0.5_wp * (                         &
-                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
-                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
-                                                     ) * ddy2
-                ENDIF
-             ENDDO
-
-!
-!--          Apply prescribed horizontal wall heatflux where necessary
-             DO  k = 1, nzt
-                IF ( k > nzb_s_inner(j,i)  .AND.  k <= nzb_s_outer(j,i)  .AND. &
-                     ( wall_w_x(j,i) /= 0.0_wp  .OR.  wall_w_y(j,i) /= 0.0_wp ) )    &
-                THEN
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                                + ( fwxp(j,i) * 0.5_wp *       &
-                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
-                        + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1)              &
-                                                   -fwxm(j,i) * 0.5_wp *       &
-                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
-                        + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2)              &
-                                                  ) * ddx2                     &
-                                                + ( fwyp(j,i) * 0.5_wp *       &
-                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
-                        + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3)              &
-                                                   -fwym(j,i) * 0.5_wp *       &
-                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
-                        + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4)              &
-                                                  ) * ddy2
-                ENDIF
-             ENDDO
-
-!
-!--          Compute vertical diffusion. In case that surface fluxes have been
-!--          prescribed or computed at bottom and/or top, index k starts/ends at
-!--          nzb+2 or nzt-1, respectively.
-             DO  k = 1, nzt_diff
-                IF ( k >= nzb_diff_s_inner(j,i) )  THEN
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                       + 0.5_wp * (                            &
-            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
-          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
-                                                  ) * ddzw(k)
-                ENDIF
-             ENDDO
-
-!
-!--          Vertical diffusion at the first computational gridpoint along
-!--          z-direction
-             DO  k = 1, nzt
-                IF ( use_surface_fluxes  .AND.  k == nzb_s_inner(j,i)+1 )  THEN
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                          + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )&
-                                                     * ( s(k+1,j,i)-s(k,j,i) ) &
-                                                     * ddzu(k+1)               &
-                                              + s_flux_b(j,i)                  &
-                                            ) * ddzw(k)
-                ENDIF
-
-!
-!--             Vertical diffusion at the last computational gridpoint along
-!--             z-direction
-                IF ( use_top_fluxes  .AND.  k == nzt )  THEN
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                          + ( - s_flux_t(j,i)                  &
-                                              - 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )&
-                                                       * ( s(k,j,i)-s(k-1,j,i) )  &
-                                                       * ddzu(k)                  &
-                                            ) * ddzw(k)
-                ENDIF
-             ENDDO
-
-          ENDDO
-       ENDDO
-       !$acc end kernels
-
-    END SUBROUTINE diffusion_s_acc
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, ddzw, kh, tend
-           
-       USE control_parameters,                                                 & 
-           ONLY: use_surface_fluxes, use_top_fluxes
-       
-       USE grid_variables,                                                     &
-           ONLY:  ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
-       
-       USE indices,                                                            &
-           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_diff_s_inner, nzb_s_inner,  &
-                  nzb_s_outer, nzt, nzt_diff
-       
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i                 !< 
-       INTEGER(iwp) ::  j                 !< 
-       INTEGER(iwp) ::  k                 !< 
-       REAL(wp)     ::  wall_s_flux(0:4)  !< 
-       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b  !< 
-       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_t  !< 
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s !< 
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  s  !< 
-#endif
-
-!
-!--    Compute horizontal diffusion
-       DO  k = nzb_s_outer(j,i)+1, nzt
-
-          tend(k,j,i) = tend(k,j,i)                                            &
-                                          + 0.5_wp * (                         &
-                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
-                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
-                                                     ) * ddx2                  &
-                                          + 0.5_wp * (                         &
-                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
-                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
-                                                     ) * ddy2
-       ENDDO
-
-!
-!--    Apply prescribed horizontal wall heatflux where necessary
-       IF ( ( wall_w_x(j,i) /= 0.0_wp ) .OR. ( wall_w_y(j,i) /= 0.0_wp ) )     &
-       THEN
-          DO  k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
-
-             tend(k,j,i) = tend(k,j,i)                                         &
-                                                + ( fwxp(j,i) * 0.5_wp *       &
-                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) )  &
-                        + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1)              &
-                                                   -fwxm(j,i) * 0.5_wp *       &
-                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) )  &
-                        + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2)              &
-                                                  ) * ddx2                     &
-                                                + ( fwyp(j,i) * 0.5_wp *       &
-                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) )  &
-                        + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3)              &
-                                                   -fwym(j,i) * 0.5_wp *       &
-                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) )  &
-                        + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4)              &
-                                                  ) * ddy2
-          ENDDO
-       ENDIF
-
-!
-!--    Compute vertical diffusion. In case that surface fluxes have been
-!--    prescribed or computed at bottom and/or top, index k starts/ends at
-!--    nzb+2 or nzt-1, respectively.
-       DO  k = nzb_diff_s_inner(j,i), nzt_diff
-
-          tend(k,j,i) = tend(k,j,i)                                            &
-                                       + 0.5_wp * (                            &
-            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1)  &
-          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)    &
-                                                  ) * ddzw(k)
-       ENDDO
-
-!
-!--    Vertical diffusion at the first computational gridpoint along z-direction
-       IF ( use_surface_fluxes )  THEN
-
-          k = nzb_s_inner(j,i)+1
-
-          tend(k,j,i) = tend(k,j,i) + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )     &
-                                               * ( s(k+1,j,i)-s(k,j,i) )       &
-                                               * ddzu(k+1)                     &
-                                        + s_flux_b(j,i)                        &
-                                      ) * ddzw(k)
-
-       ENDIF
-
-!
-!--    Vertical diffusion at the last computational gridpoint along z-direction
-       IF ( use_top_fluxes )  THEN
-
-          k = nzt
-
-          tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i)                        &
-                                      - 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )     &
-                                               * ( s(k,j,i)-s(k-1,j,i) )       &
-                                               * ddzu(k)                       &
-                                      ) * ddzw(k)
-
-       ENDIF
-
-    END SUBROUTINE diffusion_s_ij
-
- END MODULE diffusion_s_mod
Index: /palm/trunk/SOURCE/diffusion_u.f90
===================================================================
--- /palm/trunk/SOURCE/diffusion_u.f90	(revision 1873)
+++ /palm/trunk/SOURCE/diffusion_u.f90	(revision 1873)
@@ -0,0 +1,605 @@
+!> @file diffusion_u.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+!
+! 1740 2016-01-13 08:19:40Z raasch
+! unnecessary calculations of kmzm and kmzp in wall bounded parts removed
+!
+! 1691 2015-10-26 16:17:44Z maronga
+! Formatting corrections.
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1340 2014-03-25 19:45:13Z kanani
+! REAL constants defined as wp-kind
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+! 
+! 1257 2013-11-08 15:18:40Z raasch
+! openacc loop and loop vector clauses removed, declare create moved after
+! the FORTRAN declaration statement
+!
+! 1128 2013-04-12 06:19:32Z raasch
+! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
+! j_north
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1015 2012-09-27 09:23:24Z raasch
+! accelerator version (*_acc) added
+!
+! 1001 2012-09-13 14:08:46Z raasch
+! arrays comunicated by module instead of parameter list
+!
+! 978 2012-08-09 08:28:32Z fricke
+! outflow damping layer removed
+! kmym_x/_y and kmyp_x/_y change to kmym and kmyp
+!
+! Revision 1.1  1997/09/12 06:23:51  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Diffusion term of the u-component
+!> @todo additional damping (needed for non-cyclic bc) causes bad vectorization
+!>       and slows down the speed on NEC about 5-10%
+!------------------------------------------------------------------------------!
+ MODULE diffusion_u_mod
+ 
+
+    USE wall_fluxes_mod
+
+    PRIVATE
+    PUBLIC diffusion_u, diffusion_u_acc
+
+    INTERFACE diffusion_u
+       MODULE PROCEDURE diffusion_u
+       MODULE PROCEDURE diffusion_u_ij
+    END INTERFACE diffusion_u
+
+    INTERFACE diffusion_u_acc
+       MODULE PROCEDURE diffusion_u_acc
+    END INTERFACE diffusion_u_acc
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_u
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, ddzw, km, tend, u, usws, uswst, v, w
+       
+       USE control_parameters,                                                 &
+           ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
+                  use_top_fluxes
+       
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddx2, ddy, fym, fyp, wall_u
+       
+       USE indices,                                                            &
+           ONLY:  nxl, nxlu, nxr, nyn, nys, nzb, nzb_diff_u, nzb_u_inner,      &
+                  nzb_u_outer, nzt, nzt_diff
+       
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i     !< 
+       INTEGER(iwp) ::  j     !< 
+       INTEGER(iwp) ::  k     !< 
+       REAL(wp)     ::  kmym  !<
+       REAL(wp)     ::  kmyp  !<
+       REAL(wp)     ::  kmzm  !<
+       REAL(wp)     ::  kmzp  !<
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs  !< 
+
+!
+!--    First calculate horizontal momentum flux u'v' at vertical walls,
+!--    if neccessary
+       IF ( topography /= 'flat' )  THEN
+          CALL wall_fluxes( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, nzb_u_inner, &
+                            nzb_u_outer, wall_u )
+       ENDIF
+
+       DO  i = nxlu, nxr
+          DO  j = nys, nyn
+!
+!--          Compute horizontal diffusion
+             DO  k = nzb_u_outer(j,i)+1, nzt
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmyp = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+                kmym = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & + 2.0_wp * (                                           &
+                      &           km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )    &
+                      &         - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )    &
+                      &            ) * ddx2                                    &
+                      & + ( kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy         &
+                      &   + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx         &
+                      &   - kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
+                      &   - kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
+                      &   ) * ddy
+             ENDDO
+
+!
+!--          Wall functions at the north and south walls, respectively
+             IF ( wall_u(j,i) /= 0.0_wp )  THEN
+
+                DO  k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i)
+                   kmyp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+                   kmym = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                 + 2.0_wp * (                                  &
+                                       km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i) ) &
+                                     - km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
+                                            ) * ddx2                           &
+                                 + (   fyp(j,i) * (                            &
+                                  kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy   &
+                                + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx   &
+                                                  )                            &
+                                     - fym(j,i) * (                            &
+                                  kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
+                                + kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
+                                                  )                            &
+                                     + wall_u(j,i) * usvs(k,j,i)               &
+                                   ) * ddy
+                ENDDO
+             ENDIF
+
+!
+!--          Compute vertical diffusion. In case of simulating a Prandtl layer,
+!--          index k starts at nzb_u_inner+2.
+             DO  k = nzb_diff_u(j,i), nzt_diff
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmzp = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+                kmzm = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
+                      &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
+                      &            )                                           &
+                      &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
+                      &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
+                      &            )                                           &
+                      &   ) * ddzw(k)
+             ENDDO
+
+!
+!--          Vertical diffusion at the first grid point above the surface,
+!--          if the momentum flux at the bottom is given by the Prandtl law or
+!--          if it is prescribed by the user.
+!--          Difference quotient of the momentum flux is not formed over half
+!--          of the grid spacing (2.0*ddzw(k)) any more, since the comparison
+!--          with other (LES) models showed that the values of the momentum
+!--          flux becomes too large in this case.
+!--          The term containing w(k-1,..) (see above equation) is removed here
+!--          because the vertical velocity is assumed to be zero at the surface.
+             IF ( use_surface_fluxes )  THEN
+                k = nzb_u_inner(j,i)+1
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmzp = 0.25_wp *                                               &
+                      ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & + ( kmzp * ( w(k,j,i)   - w(k,j,i-1)   ) * ddx         &
+                      &   ) * ddzw(k)                                          &
+                      & + ( kmzp * ( u(k+1,j,i) - u(k,j,i)     ) * ddzu(k+1)   &
+                      &   + usws(j,i)                                          &
+                      &   ) * ddzw(k)
+             ENDIF
+
+!
+!--          Vertical diffusion at the first gridpoint below the top boundary,
+!--          if the momentum flux at the top is prescribed by the user
+             IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
+                k = nzt
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmzm = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx         &
+                      &   ) * ddzw(k)                                          &
+                      & + ( -uswst(j,i)                                        &
+                      &   - kmzm * ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)     &
+                      &   ) * ddzw(k)
+             ENDIF
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE diffusion_u
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_u_acc
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, ddzw, km, tend, u, usws, uswst, v, w
+       
+       USE control_parameters,                                                 &
+           ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
+                  use_top_fluxes
+       
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddx2, ddy, fym, fyp, wall_u
+       
+       USE indices,                                                            &
+           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
+                  nzb_diff_u, nzb_u_inner, nzb_u_outer, nzt, nzt_diff
+       
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i     !< 
+       INTEGER(iwp) ::  j     !< 
+       INTEGER(iwp) ::  k     !< 
+       REAL(wp)     ::  kmym  !<
+       REAL(wp)     ::  kmyp  !<
+       REAL(wp)     ::  kmzm  !<
+       REAL(wp)     ::  kmzp  !<
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs  !< 
+       !$acc declare create ( usvs )
+
+!
+!--    First calculate horizontal momentum flux u'v' at vertical walls,
+!--    if neccessary
+       IF ( topography /= 'flat' )  THEN
+          CALL wall_fluxes_acc( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp,          &
+                                nzb_u_inner, nzb_u_outer, wall_u )
+       ENDIF
+
+       !$acc kernels present ( u, v, w, km, tend, usws, uswst )                &
+       !$acc         present ( ddzu, ddzw, fym, fyp, wall_u )                  &
+       !$acc         present ( nzb_u_inner, nzb_u_outer, nzb_diff_u )
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+!
+!--          Compute horizontal diffusion
+             DO  k = 1, nzt
+                IF ( k > nzb_u_outer(j,i) )  THEN
+!
+!--                Interpolate eddy diffusivities on staggered gridpoints
+                   kmyp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+                   kmym = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                         & + 2.0_wp * (                                        &
+                         &           km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   ) &
+                         &         - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) ) &
+                         &            ) * ddx2                                 &
+                         & + ( kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy      &
+                         &   + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx      &
+                         &   - kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy          &
+                         &   - kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx          &
+                         &   ) * ddy
+                ENDIF
+             ENDDO
+
+!
+!--          Wall functions at the north and south walls, respectively
+             DO  k = 1, nzt
+                IF( k > nzb_u_inner(j,i)  .AND.  k <= nzb_u_outer(j,i)  .AND.  &
+                    wall_u(j,i) /= 0.0_wp )  THEN
+
+                   kmyp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+                   kmym = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                 + 2.0_wp * (                                  &
+                                       km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i) ) &
+                                     - km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
+                                            ) * ddx2                           &
+                                 + (   fyp(j,i) * (                            &
+                                  kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy   &
+                                + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx   &
+                                                  )                            &
+                                     - fym(j,i) * (                            &
+                                  kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
+                                + kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
+                                                  )                            &
+                                     + wall_u(j,i) * usvs(k,j,i)               &
+                                   ) * ddy
+                ENDIF
+             ENDDO
+
+!
+!--          Compute vertical diffusion. In case of simulating a Prandtl layer,
+!--          index k starts at nzb_u_inner+2.
+             DO  k = 1, nzt_diff
+                IF ( k >= nzb_diff_u(j,i) )  THEN
+!
+!--                Interpolate eddy diffusivities on staggered gridpoints
+                   kmzp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+                   kmzm = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                         & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)&
+                         &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx      &
+                         &            )                                        &
+                         &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)&
+                         &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx    &
+                         &            )                                        &
+                         &   ) * ddzw(k)
+                ENDIF
+             ENDDO
+
+          ENDDO
+       ENDDO
+
+!
+!--    Vertical diffusion at the first grid point above the surface,
+!--    if the momentum flux at the bottom is given by the Prandtl law or
+!--    if it is prescribed by the user.
+!--    Difference quotient of the momentum flux is not formed over half
+!--    of the grid spacing (2.0*ddzw(k)) any more, since the comparison
+!--    with other (LES) models showed that the values of the momentum
+!--    flux becomes too large in this case.
+!--    The term containing w(k-1,..) (see above equation) is removed here
+!--    because the vertical velocity is assumed to be zero at the surface.
+       IF ( use_surface_fluxes )  THEN
+
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+          
+                k = nzb_u_inner(j,i)+1
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmzp = 0.25_wp *                                               &
+                      ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & + ( kmzp * ( w(k,j,i)   - w(k,j,i-1)   ) * ddx         &
+                      &   ) * ddzw(k)                                          &
+                      & + ( kmzp * ( u(k+1,j,i) - u(k,j,i)     ) * ddzu(k+1)   &
+                      &   + usws(j,i)                                          &
+                      &   ) * ddzw(k)
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+!
+!--    Vertical diffusion at the first gridpoint below the top boundary,
+!--    if the momentum flux at the top is prescribed by the user
+       IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
+
+          k = nzt
+
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmzm = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx         &
+                      &   ) * ddzw(k)                                          &
+                      & + ( -uswst(j,i)                                        &
+                      &   - kmzm * ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)     &
+                      &   ) * ddzw(k)
+             ENDDO
+          ENDDO
+
+       ENDIF
+       !$acc end kernels
+
+    END SUBROUTINE diffusion_u_acc
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_u_ij( i, j )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, ddzw, km, tend, u, usws, uswst, v, w
+       
+       USE control_parameters,                                                 &
+           ONLY:  constant_top_momentumflux, use_surface_fluxes, use_top_fluxes
+       
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddx2, ddy, fym, fyp, wall_u
+       
+       USE indices,                                                            &
+           ONLY:  nzb, nzb_diff_u, nzb_u_inner, nzb_u_outer, nzt, nzt_diff
+       
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i     !< 
+       INTEGER(iwp) ::  j     !< 
+       INTEGER(iwp) ::  k     !< 
+       REAL(wp)     ::  kmym  !<
+       REAL(wp)     ::  kmyp  !<
+       REAL(wp)     ::  kmzm  !<
+       REAL(wp)     ::  kmzp  !<
+
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  usvs  !< 
+
+!
+!--    Compute horizontal diffusion
+       DO  k = nzb_u_outer(j,i)+1, nzt
+!
+!--       Interpolate eddy diffusivities on staggered gridpoints
+          kmyp = 0.25_wp * ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+          kmym = 0.25_wp * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+
+          tend(k,j,i) = tend(k,j,i)                                            &
+                      & + 2.0_wp * (                                           &
+                      &           km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )    &
+                      &         - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )    &
+                      &            ) * ddx2                                    &
+                      & + ( kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy         &
+                      &   + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx         &
+                      &   - kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
+                      &   - kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
+                      &   ) * ddy
+       ENDDO
+
+!
+!--    Wall functions at the north and south walls, respectively
+       IF ( wall_u(j,i) /= 0.0_wp )  THEN
+
+!
+!--       Calculate the horizontal momentum flux u'v'
+          CALL wall_fluxes( i, j, nzb_u_inner(j,i)+1, nzb_u_outer(j,i),        &
+                            usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
+
+          DO  k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i)
+             kmyp = 0.25_wp * ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+             kmym = 0.25_wp * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+
+             tend(k,j,i) = tend(k,j,i)                                         &
+                                 + 2.0_wp * (                                  &
+                                       km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i) ) &
+                                     - km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
+                                            ) * ddx2                           &
+                                 + (   fyp(j,i) * (                            &
+                                  kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy   &
+                                + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx   &
+                                                  )                            &
+                                     - fym(j,i) * (                            &
+                                  kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
+                                + kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
+                                                  )                            &
+                                     + wall_u(j,i) * usvs(k)                   &
+                                   ) * ddy
+          ENDDO
+       ENDIF
+
+!
+!--    Compute vertical diffusion. In case of simulating a Prandtl layer,
+!--    index k starts at nzb_u_inner+2.
+       DO  k = nzb_diff_u(j,i), nzt_diff
+!
+!--       Interpolate eddy diffusivities on staggered gridpoints
+          kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+          kmzm = 0.25_wp * ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
+
+          tend(k,j,i) = tend(k,j,i)                                            &
+                      & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
+                      &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
+                      &            )                                           &
+                      &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
+                      &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
+                      &            )                                           &
+                      &   ) * ddzw(k)
+       ENDDO
+
+!
+!--    Vertical diffusion at the first grid point above the surface, if the
+!--    momentum flux at the bottom is given by the Prandtl law or if it is
+!--    prescribed by the user.
+!--    Difference quotient of the momentum flux is not formed over half of
+!--    the grid spacing (2.0*ddzw(k)) any more, since the comparison with 
+!--    other (LES) models showed that the values of the momentum flux becomes
+!--    too large in this case.
+!--    The term containing w(k-1,..) (see above equation) is removed here
+!--    because the vertical velocity is assumed to be zero at the surface.
+       IF ( use_surface_fluxes )  THEN
+          k = nzb_u_inner(j,i)+1
+!
+!--       Interpolate eddy diffusivities on staggered gridpoints
+          kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+
+          tend(k,j,i) = tend(k,j,i)                                            &
+                      & + ( kmzp * ( w(k,j,i)   - w(k,j,i-1)   ) * ddx         &
+                      &   ) * ddzw(k)                                          &
+                      & + ( kmzp * ( u(k+1,j,i) - u(k,j,i)     ) * ddzu(k+1)   &
+                      &   + usws(j,i)                                          &
+                      &   ) * ddzw(k)
+       ENDIF
+
+!
+!--    Vertical diffusion at the first gridpoint below the top boundary,
+!--    if the momentum flux at the top is prescribed by the user
+       IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
+          k = nzt
+!
+!--       Interpolate eddy diffusivities on staggered gridpoints
+          kmzm = 0.25_wp *                                                     &
+                 ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
+
+          tend(k,j,i) = tend(k,j,i)                                            &
+                      & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx         &
+                      &   ) * ddzw(k)                                          &
+                      & + ( -uswst(j,i)                                        &
+                      &   - kmzm * ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)     &
+                      &   ) * ddzw(k)
+       ENDIF
+
+    END SUBROUTINE diffusion_u_ij
+
+ END MODULE diffusion_u_mod
Index: lm/trunk/SOURCE/diffusion_u_mod.f90
===================================================================
--- /palm/trunk/SOURCE/diffusion_u_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,604 +1,0 @@
-!> @file diffusion_u_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-!
-! 1740 2016-01-13 08:19:40Z raasch
-! unnecessary calculations of kmzm and kmzp in wall bounded parts removed
-!
-! 1691 2015-10-26 16:17:44Z maronga
-! Formatting corrections.
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1340 2014-03-25 19:45:13Z kanani
-! REAL constants defined as wp-kind
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-! 
-! 1257 2013-11-08 15:18:40Z raasch
-! openacc loop and loop vector clauses removed, declare create moved after
-! the FORTRAN declaration statement
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! accelerator version (*_acc) added
-!
-! 1001 2012-09-13 14:08:46Z raasch
-! arrays comunicated by module instead of parameter list
-!
-! 978 2012-08-09 08:28:32Z fricke
-! outflow damping layer removed
-! kmym_x/_y and kmyp_x/_y change to kmym and kmyp
-!
-! Revision 1.1  1997/09/12 06:23:51  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Diffusion term of the u-component
-!> @todo additional damping (needed for non-cyclic bc) causes bad vectorization
-!>       and slows down the speed on NEC about 5-10%
-!------------------------------------------------------------------------------!
- MODULE diffusion_u_mod
- 
-
-    USE wall_fluxes_mod
-
-    PRIVATE
-    PUBLIC diffusion_u, diffusion_u_acc
-
-    INTERFACE diffusion_u
-       MODULE PROCEDURE diffusion_u
-       MODULE PROCEDURE diffusion_u_ij
-    END INTERFACE diffusion_u
-
-    INTERFACE diffusion_u_acc
-       MODULE PROCEDURE diffusion_u_acc
-    END INTERFACE diffusion_u_acc
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_u
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, ddzw, km, tend, u, usws, uswst, v, w
-       
-       USE control_parameters,                                                 &
-           ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
-                  use_top_fluxes
-       
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddx2, ddy, fym, fyp, wall_u
-       
-       USE indices,                                                            &
-           ONLY:  nxl, nxlu, nxr, nyn, nys, nzb, nzb_diff_u, nzb_u_inner,      &
-                  nzb_u_outer, nzt, nzt_diff
-       
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i     !< 
-       INTEGER(iwp) ::  j     !< 
-       INTEGER(iwp) ::  k     !< 
-       REAL(wp)     ::  kmym  !<
-       REAL(wp)     ::  kmyp  !<
-       REAL(wp)     ::  kmzm  !<
-       REAL(wp)     ::  kmzp  !<
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs  !< 
-
-!
-!--    First calculate horizontal momentum flux u'v' at vertical walls,
-!--    if neccessary
-       IF ( topography /= 'flat' )  THEN
-          CALL wall_fluxes( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, nzb_u_inner, &
-                            nzb_u_outer, wall_u )
-       ENDIF
-
-       DO  i = nxlu, nxr
-          DO  j = nys, nyn
-!
-!--          Compute horizontal diffusion
-             DO  k = nzb_u_outer(j,i)+1, nzt
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmyp = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
-                kmym = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & + 2.0_wp * (                                           &
-                      &           km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )    &
-                      &         - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )    &
-                      &            ) * ddx2                                    &
-                      & + ( kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy         &
-                      &   + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx         &
-                      &   - kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
-                      &   - kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
-                      &   ) * ddy
-             ENDDO
-
-!
-!--          Wall functions at the north and south walls, respectively
-             IF ( wall_u(j,i) /= 0.0_wp )  THEN
-
-                DO  k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i)
-                   kmyp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
-                   kmym = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
-
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                 + 2.0_wp * (                                  &
-                                       km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i) ) &
-                                     - km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
-                                            ) * ddx2                           &
-                                 + (   fyp(j,i) * (                            &
-                                  kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy   &
-                                + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx   &
-                                                  )                            &
-                                     - fym(j,i) * (                            &
-                                  kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
-                                + kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
-                                                  )                            &
-                                     + wall_u(j,i) * usvs(k,j,i)               &
-                                   ) * ddy
-                ENDDO
-             ENDIF
-
-!
-!--          Compute vertical diffusion. In case of simulating a Prandtl layer,
-!--          index k starts at nzb_u_inner+2.
-             DO  k = nzb_diff_u(j,i), nzt_diff
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmzp = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
-                kmzm = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
-                      &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
-                      &            )                                           &
-                      &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
-                      &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
-                      &            )                                           &
-                      &   ) * ddzw(k)
-             ENDDO
-
-!
-!--          Vertical diffusion at the first grid point above the surface,
-!--          if the momentum flux at the bottom is given by the Prandtl law or
-!--          if it is prescribed by the user.
-!--          Difference quotient of the momentum flux is not formed over half
-!--          of the grid spacing (2.0*ddzw(k)) any more, since the comparison
-!--          with other (LES) models showed that the values of the momentum
-!--          flux becomes too large in this case.
-!--          The term containing w(k-1,..) (see above equation) is removed here
-!--          because the vertical velocity is assumed to be zero at the surface.
-             IF ( use_surface_fluxes )  THEN
-                k = nzb_u_inner(j,i)+1
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmzp = 0.25_wp *                                               &
-                      ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & + ( kmzp * ( w(k,j,i)   - w(k,j,i-1)   ) * ddx         &
-                      &   ) * ddzw(k)                                          &
-                      & + ( kmzp * ( u(k+1,j,i) - u(k,j,i)     ) * ddzu(k+1)   &
-                      &   + usws(j,i)                                          &
-                      &   ) * ddzw(k)
-             ENDIF
-
-!
-!--          Vertical diffusion at the first gridpoint below the top boundary,
-!--          if the momentum flux at the top is prescribed by the user
-             IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
-                k = nzt
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmzm = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx         &
-                      &   ) * ddzw(k)                                          &
-                      & + ( -uswst(j,i)                                        &
-                      &   - kmzm * ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)     &
-                      &   ) * ddzw(k)
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE diffusion_u
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_u_acc
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, ddzw, km, tend, u, usws, uswst, v, w
-       
-       USE control_parameters,                                                 &
-           ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
-                  use_top_fluxes
-       
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddx2, ddy, fym, fyp, wall_u
-       
-       USE indices,                                                            &
-           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
-                  nzb_diff_u, nzb_u_inner, nzb_u_outer, nzt, nzt_diff
-       
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i     !< 
-       INTEGER(iwp) ::  j     !< 
-       INTEGER(iwp) ::  k     !< 
-       REAL(wp)     ::  kmym  !<
-       REAL(wp)     ::  kmyp  !<
-       REAL(wp)     ::  kmzm  !<
-       REAL(wp)     ::  kmzp  !<
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs  !< 
-       !$acc declare create ( usvs )
-
-!
-!--    First calculate horizontal momentum flux u'v' at vertical walls,
-!--    if neccessary
-       IF ( topography /= 'flat' )  THEN
-          CALL wall_fluxes_acc( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp,          &
-                                nzb_u_inner, nzb_u_outer, wall_u )
-       ENDIF
-
-       !$acc kernels present ( u, v, w, km, tend, usws, uswst )                &
-       !$acc         present ( ddzu, ddzw, fym, fyp, wall_u )                  &
-       !$acc         present ( nzb_u_inner, nzb_u_outer, nzb_diff_u )
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-!
-!--          Compute horizontal diffusion
-             DO  k = 1, nzt
-                IF ( k > nzb_u_outer(j,i) )  THEN
-!
-!--                Interpolate eddy diffusivities on staggered gridpoints
-                   kmyp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
-                   kmym = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
-
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                         & + 2.0_wp * (                                        &
-                         &           km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   ) &
-                         &         - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) ) &
-                         &            ) * ddx2                                 &
-                         & + ( kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy      &
-                         &   + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx      &
-                         &   - kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy          &
-                         &   - kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx          &
-                         &   ) * ddy
-                ENDIF
-             ENDDO
-
-!
-!--          Wall functions at the north and south walls, respectively
-             DO  k = 1, nzt
-                IF( k > nzb_u_inner(j,i)  .AND.  k <= nzb_u_outer(j,i)  .AND.  &
-                    wall_u(j,i) /= 0.0_wp )  THEN
-
-                   kmyp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
-                   kmym = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
-
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                 + 2.0_wp * (                                  &
-                                       km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i) ) &
-                                     - km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
-                                            ) * ddx2                           &
-                                 + (   fyp(j,i) * (                            &
-                                  kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy   &
-                                + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx   &
-                                                  )                            &
-                                     - fym(j,i) * (                            &
-                                  kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
-                                + kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
-                                                  )                            &
-                                     + wall_u(j,i) * usvs(k,j,i)               &
-                                   ) * ddy
-                ENDIF
-             ENDDO
-
-!
-!--          Compute vertical diffusion. In case of simulating a Prandtl layer,
-!--          index k starts at nzb_u_inner+2.
-             DO  k = 1, nzt_diff
-                IF ( k >= nzb_diff_u(j,i) )  THEN
-!
-!--                Interpolate eddy diffusivities on staggered gridpoints
-                   kmzp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
-                   kmzm = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
-
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                         & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)&
-                         &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx      &
-                         &            )                                        &
-                         &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)&
-                         &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx    &
-                         &            )                                        &
-                         &   ) * ddzw(k)
-                ENDIF
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-!
-!--    Vertical diffusion at the first grid point above the surface,
-!--    if the momentum flux at the bottom is given by the Prandtl law or
-!--    if it is prescribed by the user.
-!--    Difference quotient of the momentum flux is not formed over half
-!--    of the grid spacing (2.0*ddzw(k)) any more, since the comparison
-!--    with other (LES) models showed that the values of the momentum
-!--    flux becomes too large in this case.
-!--    The term containing w(k-1,..) (see above equation) is removed here
-!--    because the vertical velocity is assumed to be zero at the surface.
-       IF ( use_surface_fluxes )  THEN
-
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-          
-                k = nzb_u_inner(j,i)+1
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmzp = 0.25_wp *                                               &
-                      ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & + ( kmzp * ( w(k,j,i)   - w(k,j,i-1)   ) * ddx         &
-                      &   ) * ddzw(k)                                          &
-                      & + ( kmzp * ( u(k+1,j,i) - u(k,j,i)     ) * ddzu(k+1)   &
-                      &   + usws(j,i)                                          &
-                      &   ) * ddzw(k)
-             ENDDO
-          ENDDO
-
-       ENDIF
-
-!
-!--    Vertical diffusion at the first gridpoint below the top boundary,
-!--    if the momentum flux at the top is prescribed by the user
-       IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
-
-          k = nzt
-
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmzm = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx         &
-                      &   ) * ddzw(k)                                          &
-                      & + ( -uswst(j,i)                                        &
-                      &   - kmzm * ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)     &
-                      &   ) * ddzw(k)
-             ENDDO
-          ENDDO
-
-       ENDIF
-       !$acc end kernels
-
-    END SUBROUTINE diffusion_u_acc
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_u_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, ddzw, km, tend, u, usws, uswst, v, w
-       
-       USE control_parameters,                                                 &
-           ONLY:  constant_top_momentumflux, use_surface_fluxes, use_top_fluxes
-       
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddx2, ddy, fym, fyp, wall_u
-       
-       USE indices,                                                            &
-           ONLY:  nzb, nzb_diff_u, nzb_u_inner, nzb_u_outer, nzt, nzt_diff
-       
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i     !< 
-       INTEGER(iwp) ::  j     !< 
-       INTEGER(iwp) ::  k     !< 
-       REAL(wp)     ::  kmym  !<
-       REAL(wp)     ::  kmyp  !<
-       REAL(wp)     ::  kmzm  !<
-       REAL(wp)     ::  kmzp  !<
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  usvs  !< 
-
-!
-!--    Compute horizontal diffusion
-       DO  k = nzb_u_outer(j,i)+1, nzt
-!
-!--       Interpolate eddy diffusivities on staggered gridpoints
-          kmyp = 0.25_wp * ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
-          kmym = 0.25_wp * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
-
-          tend(k,j,i) = tend(k,j,i)                                            &
-                      & + 2.0_wp * (                                           &
-                      &           km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i)   )    &
-                      &         - km(k,j,i-1) * ( u(k,j,i)   - u(k,j,i-1) )    &
-                      &            ) * ddx2                                    &
-                      & + ( kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy         &
-                      &   + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx         &
-                      &   - kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
-                      &   - kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
-                      &   ) * ddy
-       ENDDO
-
-!
-!--    Wall functions at the north and south walls, respectively
-       IF ( wall_u(j,i) /= 0.0_wp )  THEN
-
-!
-!--       Calculate the horizontal momentum flux u'v'
-          CALL wall_fluxes( i, j, nzb_u_inner(j,i)+1, nzb_u_outer(j,i),        &
-                            usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
-
-          DO  k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i)
-             kmyp = 0.25_wp * ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
-             kmym = 0.25_wp * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
-
-             tend(k,j,i) = tend(k,j,i)                                         &
-                                 + 2.0_wp * (                                  &
-                                       km(k,j,i)   * ( u(k,j,i+1) - u(k,j,i) ) &
-                                     - km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
-                                            ) * ddx2                           &
-                                 + (   fyp(j,i) * (                            &
-                                  kmyp * ( u(k,j+1,i) - u(k,j,i)     ) * ddy   &
-                                + kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx   &
-                                                  )                            &
-                                     - fym(j,i) * (                            &
-                                  kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
-                                + kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
-                                                  )                            &
-                                     + wall_u(j,i) * usvs(k)                   &
-                                   ) * ddy
-          ENDDO
-       ENDIF
-
-!
-!--    Compute vertical diffusion. In case of simulating a Prandtl layer,
-!--    index k starts at nzb_u_inner+2.
-       DO  k = nzb_diff_u(j,i), nzt_diff
-!
-!--       Interpolate eddy diffusivities on staggered gridpoints
-          kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
-          kmzm = 0.25_wp * ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
-
-          tend(k,j,i) = tend(k,j,i)                                            &
-                      & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)   &
-                      &            + ( w(k,j,i)   - w(k,j,i-1) ) * ddx         &
-                      &            )                                           &
-                      &   - kmzm * ( ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)   &
-                      &            + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx       &
-                      &            )                                           &
-                      &   ) * ddzw(k)
-       ENDDO
-
-!
-!--    Vertical diffusion at the first grid point above the surface, if the
-!--    momentum flux at the bottom is given by the Prandtl law or if it is
-!--    prescribed by the user.
-!--    Difference quotient of the momentum flux is not formed over half of
-!--    the grid spacing (2.0*ddzw(k)) any more, since the comparison with 
-!--    other (LES) models showed that the values of the momentum flux becomes
-!--    too large in this case.
-!--    The term containing w(k-1,..) (see above equation) is removed here
-!--    because the vertical velocity is assumed to be zero at the surface.
-       IF ( use_surface_fluxes )  THEN
-          k = nzb_u_inner(j,i)+1
-!
-!--       Interpolate eddy diffusivities on staggered gridpoints
-          kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
-
-          tend(k,j,i) = tend(k,j,i)                                            &
-                      & + ( kmzp * ( w(k,j,i)   - w(k,j,i-1)   ) * ddx         &
-                      &   ) * ddzw(k)                                          &
-                      & + ( kmzp * ( u(k+1,j,i) - u(k,j,i)     ) * ddzu(k+1)   &
-                      &   + usws(j,i)                                          &
-                      &   ) * ddzw(k)
-       ENDIF
-
-!
-!--    Vertical diffusion at the first gridpoint below the top boundary,
-!--    if the momentum flux at the top is prescribed by the user
-       IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
-          k = nzt
-!
-!--       Interpolate eddy diffusivities on staggered gridpoints
-          kmzm = 0.25_wp *                                                     &
-                 ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
-
-          tend(k,j,i) = tend(k,j,i)                                            &
-                      & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx         &
-                      &   ) * ddzw(k)                                          &
-                      & + ( -uswst(j,i)                                        &
-                      &   - kmzm * ( u(k,j,i)   - u(k-1,j,i)   ) * ddzu(k)     &
-                      &   ) * ddzw(k)
-       ENDIF
-
-    END SUBROUTINE diffusion_u_ij
-
- END MODULE diffusion_u_mod
Index: /palm/trunk/SOURCE/diffusion_v.f90
===================================================================
--- /palm/trunk/SOURCE/diffusion_v.f90	(revision 1873)
+++ /palm/trunk/SOURCE/diffusion_v.f90	(revision 1873)
@@ -0,0 +1,602 @@
+!> @file diffusion_v.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+!
+! 1740 2016-01-13 08:19:40Z raasch
+! unnecessary calculations of kmzm and kmzp in wall bounded parts removed
+!
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1340 2014-03-25 19:45:13Z kanani
+! REAL constants defined as wp-kind
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+! 
+! 1257 2013-11-08 15:18:40Z raasch
+! openacc loop and loop vector clauses removed, declare create moved after
+! the FORTRAN declaration statement
+!
+! 1128 2013-04-12 06:19:32Z raasch
+! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
+! j_north
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1015 2012-09-27 09:23:24Z raasch
+! accelerator version (*_acc) added
+!
+! 1001 2012-09-13 14:08:46Z raasch
+! arrays comunicated by module instead of parameter list
+!
+! 978 2012-08-09 08:28:32Z fricke
+! outflow damping layer removed
+! kmxm_x/_y and kmxp_x/_y change to kmxm and kmxp
+!
+! Revision 1.1  1997/09/12 06:24:01  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Diffusion term of the v-component
+!------------------------------------------------------------------------------!
+ MODULE diffusion_v_mod
+ 
+
+    USE wall_fluxes_mod
+
+    PRIVATE
+    PUBLIC diffusion_v, diffusion_v_acc
+
+    INTERFACE diffusion_v
+       MODULE PROCEDURE diffusion_v
+       MODULE PROCEDURE diffusion_v_ij
+    END INTERFACE diffusion_v
+
+    INTERFACE diffusion_v_acc
+       MODULE PROCEDURE diffusion_v_acc
+    END INTERFACE diffusion_v_acc
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_v
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, ddzw, km, tend, u, v, vsws, vswst, w
+       
+       USE control_parameters,                                                 &
+           ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
+                  use_top_fluxes
+       
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy, ddy2, fxm, fxp, wall_v
+       
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_diff_v, nzb_v_inner,      &
+                  nzb_v_outer, nzt, nzt_diff
+       
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i     !< 
+       INTEGER(iwp) ::  j     !< 
+       INTEGER(iwp) ::  k     !< 
+       REAL(wp)     ::  kmxm  !< 
+       REAL(wp)     ::  kmxp  !< 
+       REAL(wp)     ::  kmzm  !< 
+       REAL(wp)     ::  kmzp  !< 
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  vsus  !< 
+
+!
+!--    First calculate horizontal momentum flux v'u' at vertical walls,
+!--    if neccessary
+       IF ( topography /= 'flat' )  THEN
+          CALL wall_fluxes( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, nzb_v_inner, &
+                            nzb_v_outer, wall_v )
+       ENDIF
+
+       DO  i = nxl, nxr
+          DO  j = nysv, nyn
+!
+!--          Compute horizontal diffusion
+             DO  k = nzb_v_outer(j,i)+1, nzt
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmxp = 0.25_wp * &
+                       ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+                kmxm = 0.25_wp * &
+                       ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & + ( kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx         &
+                      &   + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy         &
+                      &   - kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
+                      &   - kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
+                      &   ) * ddx                                              &
+                      & + 2.0_wp * (                                           &
+                      &           km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) )      &
+                      &         - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) )      &
+                      &            ) * ddy2
+             ENDDO
+
+!
+!--          Wall functions at the left and right walls, respectively
+             IF ( wall_v(j,i) /= 0.0_wp )  THEN
+
+                DO  k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i)
+                   kmxp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+                   kmxm = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+                   
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                 + 2.0_wp * (                                  &
+                                       km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) ) &
+                                     - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) ) &
+                                            ) * ddy2                           &
+                                 + (   fxp(j,i) * (                            &
+                                  kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx   &
+                                + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy   &
+                                                  )                            &
+                                     - fxm(j,i) * (                            &
+                                  kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
+                                + kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
+                                                  )                            &
+                                     + wall_v(j,i) * vsus(k,j,i)               &
+                                   ) * ddx
+                ENDDO
+             ENDIF
+
+!
+!--          Compute vertical diffusion. In case of simulating a Prandtl
+!--          layer, index k starts at nzb_v_inner+2.
+             DO  k = nzb_diff_v(j,i), nzt_diff
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmzp = 0.25_wp * &
+                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+                kmzm = 0.25_wp * &
+                       ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)     &
+                      &            + ( w(k,j,i) - w(k,j-1,i) ) * ddy           &
+                      &            )                                           &
+                      &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)   &
+                      &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy       &
+                      &            )                                           &
+                      &   ) * ddzw(k)
+             ENDDO
+
+!
+!--          Vertical diffusion at the first grid point above the surface,
+!--          if the momentum flux at the bottom is given by the Prandtl law
+!--          or if it is prescribed by the user.
+!--          Difference quotient of the momentum flux is not formed over
+!--          half of the grid spacing (2.0*ddzw(k)) any more, since the
+!--          comparison with other (LES) models showed that the values of
+!--          the momentum flux becomes too large in this case.
+!--          The term containing w(k-1,..) (see above equation) is removed here
+!--          because the vertical velocity is assumed to be zero at the surface.
+             IF ( use_surface_fluxes )  THEN
+                k = nzb_v_inner(j,i)+1
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmzp = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & + ( kmzp * ( w(k,j,i) - w(k,j-1,i)     ) * ddy         &
+                      &   ) * ddzw(k)                                          &
+                      & + ( kmzp * ( v(k+1,j,i) - v(k,j,i)     ) * ddzu(k+1)   &
+                      &   + vsws(j,i)                                          &
+                      &   ) * ddzw(k)
+             ENDIF
+
+!
+!--          Vertical diffusion at the first gridpoint below the top boundary,
+!--          if the momentum flux at the top is prescribed by the user
+             IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
+                k = nzt
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmzm = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & - ( kmzm *  ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy        &
+                      &   ) * ddzw(k)                                          &
+                      & + ( -vswst(j,i)                                        &
+                      &   - kmzm * ( v(k,j,i)   - v(k-1,j,i)    ) * ddzu(k)    &
+                      &   ) * ddzw(k)
+             ENDIF
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE diffusion_v
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_v_acc
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, ddzw, km, tend, u, v, vsws, vswst, w
+       
+       USE control_parameters,                                                 &
+           ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
+                  use_top_fluxes
+       
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy, ddy2, fxm, fxp, wall_v
+       
+       USE indices,                                                            &
+           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
+                  nzb_diff_v, nzb_v_inner, nzb_v_outer, nzt, nzt_diff
+       
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i     !< 
+       INTEGER(iwp) ::  j     !< 
+       INTEGER(iwp) ::  k     !< 
+       REAL(wp)     ::  kmxm  !< 
+       REAL(wp)     ::  kmxp  !< 
+       REAL(wp)     ::  kmzm  !< 
+       REAL(wp)     ::  kmzp  !< 
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  vsus  !< 
+       !$acc declare create ( vsus )
+
+!
+!--    First calculate horizontal momentum flux v'u' at vertical walls,
+!--    if neccessary
+       IF ( topography /= 'flat' )  THEN
+          CALL wall_fluxes_acc( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp,          &
+                                nzb_v_inner, nzb_v_outer, wall_v )
+       ENDIF
+
+       !$acc kernels present ( u, v, w, km, tend, vsws, vswst )                &
+       !$acc         present ( ddzu, ddzw, fxm, fxp, wall_v )                  &
+       !$acc         present ( nzb_v_inner, nzb_v_outer, nzb_diff_v )
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+!
+!--          Compute horizontal diffusion
+             DO  k = 1, nzt
+                IF ( k > nzb_v_outer(j,i) )  THEN
+!
+!--                Interpolate eddy diffusivities on staggered gridpoints
+                   kmxp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+                   kmxm = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                         & + ( kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx      &
+                         &   + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy      &
+                         &   - kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx          &
+                         &   - kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy          &
+                         &   ) * ddx                                           &
+                         & + 2.0_wp * (                                        &
+                         &           km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) )   &
+                         &         - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) )   &
+                         &            ) * ddy2
+                ENDIF
+             ENDDO
+
+!
+!--          Wall functions at the left and right walls, respectively
+             DO  k = 1, nzt
+                IF( k > nzb_v_inner(j,i)  .AND.  k <= nzb_v_outer(j,i)  .AND.  &
+                    wall_v(j,i) /= 0.0_wp )  THEN
+
+                   kmxp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+                   kmxm = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+                   
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                 + 2.0_wp * (                                  &
+                                       km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) ) &
+                                     - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) ) &
+                                            ) * ddy2                           &
+                                 + (   fxp(j,i) * (                            &
+                                  kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx   &
+                                + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy   &
+                                                  )                            &
+                                     - fxm(j,i) * (                            &
+                                  kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
+                                + kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
+                                                  )                            &
+                                     + wall_v(j,i) * vsus(k,j,i)               &
+                                   ) * ddx
+                ENDIF
+             ENDDO
+
+!
+!--          Compute vertical diffusion. In case of simulating a Prandtl
+!--          layer, index k starts at nzb_v_inner+2.
+             DO  k = 1, nzt_diff
+                IF ( k >= nzb_diff_v(j,i) )  THEN
+!
+!--                Interpolate eddy diffusivities on staggered gridpoints
+                   kmzp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+                   kmzm = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                         & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)&
+                         &            + ( w(k,j,i)   - w(k,j-1,i) ) * ddy      &
+                         &            )                                        &
+                         &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)&
+                         &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy    &
+                         &            )                                        &
+                         &   ) * ddzw(k)
+                ENDIF
+             ENDDO
+
+          ENDDO
+       ENDDO
+
+!
+!--    Vertical diffusion at the first grid point above the surface,
+!--    if the momentum flux at the bottom is given by the Prandtl law
+!--    or if it is prescribed by the user.
+!--    Difference quotient of the momentum flux is not formed over
+!--    half of the grid spacing (2.0*ddzw(k)) any more, since the
+!--    comparison with other (LES) models showed that the values of
+!--    the momentum flux becomes too large in this case.
+!--    The term containing w(k-1,..) (see above equation) is removed here
+!--    because the vertical velocity is assumed to be zero at the surface.
+       IF ( use_surface_fluxes )  THEN
+
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+          
+                k = nzb_v_inner(j,i)+1
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmzp = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & + ( kmzp * ( w(k,j,i) - w(k,j-1,i)     ) * ddy         &
+                      &   ) * ddzw(k)                                          &
+                      & + ( kmzp * ( v(k+1,j,i) - v(k,j,i)     ) * ddzu(k+1)   &
+                      &   + vsws(j,i)                                          &
+                      &   ) * ddzw(k)
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+!
+!--    Vertical diffusion at the first gridpoint below the top boundary,
+!--    if the momentum flux at the top is prescribed by the user
+       IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
+
+          k = nzt
+
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmzm = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & - ( kmzm *  ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy        &
+                      &   ) * ddzw(k)                                          &
+                      & + ( -vswst(j,i)                                        &
+                      &   - kmzm * ( v(k,j,i)   - v(k-1,j,i)    ) * ddzu(k)    &
+                      &   ) * ddzw(k)
+             ENDDO
+          ENDDO
+
+       ENDIF
+       !$acc end kernels
+
+    END SUBROUTINE diffusion_v_acc
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_v_ij( i, j )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzu, ddzw, km, tend, u, v, vsws, vswst, w
+       
+       USE control_parameters,                                                 &
+           ONLY:  constant_top_momentumflux, use_surface_fluxes, use_top_fluxes
+       
+       USE grid_variables,                                                     &
+           ONLY:  ddx, ddy, ddy2, fxm, fxp, wall_v
+       
+       USE indices,                                                            &
+           ONLY:  nzb, nzb_diff_v, nzb_v_inner, nzb_v_outer, nzt, nzt_diff
+       
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i     !< 
+       INTEGER(iwp) ::  j     !< 
+       INTEGER(iwp) ::  k     !< 
+       REAL(wp)     ::  kmxm  !< 
+       REAL(wp)     ::  kmxp  !< 
+       REAL(wp)     ::  kmzm  !< 
+       REAL(wp)     ::  kmzp  !< 
+
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  vsus  !< 
+
+!
+!--    Compute horizontal diffusion
+       DO  k = nzb_v_outer(j,i)+1, nzt
+!
+!--       Interpolate eddy diffusivities on staggered gridpoints
+          kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+          kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+
+          tend(k,j,i) = tend(k,j,i)                                            &
+                      & + ( kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx         &
+                      &   + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy         &
+                      &   - kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
+                      &   - kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
+                      &   ) * ddx                                              &
+                      & + 2.0_wp * (                                           &
+                      &           km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) )      &
+                      &         - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) )      &
+                      &            ) * ddy2
+       ENDDO
+
+!
+!--    Wall functions at the left and right walls, respectively
+       IF ( wall_v(j,i) /= 0.0_wp )  THEN
+
+!
+!--       Calculate the horizontal momentum flux v'u'
+          CALL wall_fluxes( i, j, nzb_v_inner(j,i)+1, nzb_v_outer(j,i),        &
+                            vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
+
+          DO  k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i)
+             kmxp = 0.25_wp *                                                  &
+                    ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+             kmxm = 0.25_wp *                                                  &
+                    ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+
+             tend(k,j,i) = tend(k,j,i)                                         &
+                                 + 2.0_wp * (                                  &
+                                       km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) ) &
+                                     - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) ) &
+                                            ) * ddy2                           &
+                                 + (   fxp(j,i) * (                            &
+                                  kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx   &
+                                + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy   &
+                                                  )                            &
+                                     - fxm(j,i) * (                            &
+                                  kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
+                                + kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
+                                                  )                            &
+                                     + wall_v(j,i) * vsus(k)                   &
+                                   ) * ddx
+          ENDDO
+       ENDIF
+
+!
+!--    Compute vertical diffusion. In case of simulating a Prandtl layer,
+!--    index k starts at nzb_v_inner+2.
+       DO  k = nzb_diff_v(j,i), nzt_diff
+!
+!--       Interpolate eddy diffusivities on staggered gridpoints
+          kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+          kmzm = 0.25_wp * ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
+
+          tend(k,j,i) = tend(k,j,i)                                            &
+                      & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)     &
+                      &            + ( w(k,j,i) - w(k,j-1,i) ) * ddy           &
+                      &            )                                           &
+                      &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)   &
+                      &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy       &
+                      &            )                                           &
+                      &   ) * ddzw(k)
+       ENDDO
+
+!
+!--    Vertical diffusion at the first grid point above the surface, if the
+!--    momentum flux at the bottom is given by the Prandtl law or if it is
+!--    prescribed by the user.
+!--    Difference quotient of the momentum flux is not formed over half of
+!--    the grid spacing (2.0*ddzw(k)) any more, since the comparison with 
+!--    other (LES) models showed that the values of the momentum flux becomes
+!--    too large in this case.
+!--    The term containing w(k-1,..) (see above equation) is removed here
+!--    because the vertical velocity is assumed to be zero at the surface.
+       IF ( use_surface_fluxes )  THEN
+          k = nzb_v_inner(j,i)+1
+!
+!--       Interpolate eddy diffusivities on staggered gridpoints
+          kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+
+          tend(k,j,i) = tend(k,j,i)                                            &
+                      & + ( kmzp * ( w(k,j,i) - w(k,j-1,i)     ) * ddy         &
+                      &   ) * ddzw(k)                                          &
+                      & + ( kmzp * ( v(k+1,j,i) - v(k,j,i)     ) * ddzu(k+1)   &
+                      &   + vsws(j,i)                                          &
+                      &   ) * ddzw(k)
+       ENDIF
+
+!
+!--    Vertical diffusion at the first gridpoint below the top boundary,
+!--    if the momentum flux at the top is prescribed by the user
+       IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
+          k = nzt
+!
+!--       Interpolate eddy diffusivities on staggered gridpoints
+          kmzm = 0.25_wp * &
+                 ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
+
+          tend(k,j,i) = tend(k,j,i)                                            &
+                      & - ( kmzm *  ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy        &
+                      &   ) * ddzw(k)                                          &
+                      & + ( -vswst(j,i)                                        &
+                      &   - kmzm * ( v(k,j,i)   - v(k-1,j,i)    ) * ddzu(k)    &
+                      &   ) * ddzw(k)
+       ENDIF
+
+    END SUBROUTINE diffusion_v_ij
+
+ END MODULE diffusion_v_mod
Index: lm/trunk/SOURCE/diffusion_v_mod.f90
===================================================================
--- /palm/trunk/SOURCE/diffusion_v_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,601 +1,0 @@
-!> @file diffusion_v_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-!
-! 1740 2016-01-13 08:19:40Z raasch
-! unnecessary calculations of kmzm and kmzp in wall bounded parts removed
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1340 2014-03-25 19:45:13Z kanani
-! REAL constants defined as wp-kind
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-! 
-! 1257 2013-11-08 15:18:40Z raasch
-! openacc loop and loop vector clauses removed, declare create moved after
-! the FORTRAN declaration statement
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! accelerator version (*_acc) added
-!
-! 1001 2012-09-13 14:08:46Z raasch
-! arrays comunicated by module instead of parameter list
-!
-! 978 2012-08-09 08:28:32Z fricke
-! outflow damping layer removed
-! kmxm_x/_y and kmxp_x/_y change to kmxm and kmxp
-!
-! Revision 1.1  1997/09/12 06:24:01  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Diffusion term of the v-component
-!------------------------------------------------------------------------------!
- MODULE diffusion_v_mod
- 
-
-    USE wall_fluxes_mod
-
-    PRIVATE
-    PUBLIC diffusion_v, diffusion_v_acc
-
-    INTERFACE diffusion_v
-       MODULE PROCEDURE diffusion_v
-       MODULE PROCEDURE diffusion_v_ij
-    END INTERFACE diffusion_v
-
-    INTERFACE diffusion_v_acc
-       MODULE PROCEDURE diffusion_v_acc
-    END INTERFACE diffusion_v_acc
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_v
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, ddzw, km, tend, u, v, vsws, vswst, w
-       
-       USE control_parameters,                                                 &
-           ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
-                  use_top_fluxes
-       
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy, ddy2, fxm, fxp, wall_v
-       
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nyn, nys, nysv, nzb, nzb_diff_v, nzb_v_inner,      &
-                  nzb_v_outer, nzt, nzt_diff
-       
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i     !< 
-       INTEGER(iwp) ::  j     !< 
-       INTEGER(iwp) ::  k     !< 
-       REAL(wp)     ::  kmxm  !< 
-       REAL(wp)     ::  kmxp  !< 
-       REAL(wp)     ::  kmzm  !< 
-       REAL(wp)     ::  kmzp  !< 
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  vsus  !< 
-
-!
-!--    First calculate horizontal momentum flux v'u' at vertical walls,
-!--    if neccessary
-       IF ( topography /= 'flat' )  THEN
-          CALL wall_fluxes( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, nzb_v_inner, &
-                            nzb_v_outer, wall_v )
-       ENDIF
-
-       DO  i = nxl, nxr
-          DO  j = nysv, nyn
-!
-!--          Compute horizontal diffusion
-             DO  k = nzb_v_outer(j,i)+1, nzt
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmxp = 0.25_wp * &
-                       ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
-                kmxm = 0.25_wp * &
-                       ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & + ( kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx         &
-                      &   + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy         &
-                      &   - kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
-                      &   - kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
-                      &   ) * ddx                                              &
-                      & + 2.0_wp * (                                           &
-                      &           km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) )      &
-                      &         - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) )      &
-                      &            ) * ddy2
-             ENDDO
-
-!
-!--          Wall functions at the left and right walls, respectively
-             IF ( wall_v(j,i) /= 0.0_wp )  THEN
-
-                DO  k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i)
-                   kmxp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
-                   kmxm = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
-                   
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                 + 2.0_wp * (                                  &
-                                       km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) ) &
-                                     - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) ) &
-                                            ) * ddy2                           &
-                                 + (   fxp(j,i) * (                            &
-                                  kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx   &
-                                + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy   &
-                                                  )                            &
-                                     - fxm(j,i) * (                            &
-                                  kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
-                                + kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
-                                                  )                            &
-                                     + wall_v(j,i) * vsus(k,j,i)               &
-                                   ) * ddx
-                ENDDO
-             ENDIF
-
-!
-!--          Compute vertical diffusion. In case of simulating a Prandtl
-!--          layer, index k starts at nzb_v_inner+2.
-             DO  k = nzb_diff_v(j,i), nzt_diff
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmzp = 0.25_wp * &
-                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
-                kmzm = 0.25_wp * &
-                       ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)     &
-                      &            + ( w(k,j,i) - w(k,j-1,i) ) * ddy           &
-                      &            )                                           &
-                      &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)   &
-                      &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy       &
-                      &            )                                           &
-                      &   ) * ddzw(k)
-             ENDDO
-
-!
-!--          Vertical diffusion at the first grid point above the surface,
-!--          if the momentum flux at the bottom is given by the Prandtl law
-!--          or if it is prescribed by the user.
-!--          Difference quotient of the momentum flux is not formed over
-!--          half of the grid spacing (2.0*ddzw(k)) any more, since the
-!--          comparison with other (LES) models showed that the values of
-!--          the momentum flux becomes too large in this case.
-!--          The term containing w(k-1,..) (see above equation) is removed here
-!--          because the vertical velocity is assumed to be zero at the surface.
-             IF ( use_surface_fluxes )  THEN
-                k = nzb_v_inner(j,i)+1
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmzp = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & + ( kmzp * ( w(k,j,i) - w(k,j-1,i)     ) * ddy         &
-                      &   ) * ddzw(k)                                          &
-                      & + ( kmzp * ( v(k+1,j,i) - v(k,j,i)     ) * ddzu(k+1)   &
-                      &   + vsws(j,i)                                          &
-                      &   ) * ddzw(k)
-             ENDIF
-
-!
-!--          Vertical diffusion at the first gridpoint below the top boundary,
-!--          if the momentum flux at the top is prescribed by the user
-             IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
-                k = nzt
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmzm = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & - ( kmzm *  ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy        &
-                      &   ) * ddzw(k)                                          &
-                      & + ( -vswst(j,i)                                        &
-                      &   - kmzm * ( v(k,j,i)   - v(k-1,j,i)    ) * ddzu(k)    &
-                      &   ) * ddzw(k)
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE diffusion_v
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_v_acc
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, ddzw, km, tend, u, v, vsws, vswst, w
-       
-       USE control_parameters,                                                 &
-           ONLY:  constant_top_momentumflux, topography, use_surface_fluxes,   &
-                  use_top_fluxes
-       
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy, ddy2, fxm, fxp, wall_v
-       
-       USE indices,                                                            &
-           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb,  &
-                  nzb_diff_v, nzb_v_inner, nzb_v_outer, nzt, nzt_diff
-       
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i     !< 
-       INTEGER(iwp) ::  j     !< 
-       INTEGER(iwp) ::  k     !< 
-       REAL(wp)     ::  kmxm  !< 
-       REAL(wp)     ::  kmxp  !< 
-       REAL(wp)     ::  kmzm  !< 
-       REAL(wp)     ::  kmzp  !< 
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  vsus  !< 
-       !$acc declare create ( vsus )
-
-!
-!--    First calculate horizontal momentum flux v'u' at vertical walls,
-!--    if neccessary
-       IF ( topography /= 'flat' )  THEN
-          CALL wall_fluxes_acc( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp,          &
-                                nzb_v_inner, nzb_v_outer, wall_v )
-       ENDIF
-
-       !$acc kernels present ( u, v, w, km, tend, vsws, vswst )                &
-       !$acc         present ( ddzu, ddzw, fxm, fxp, wall_v )                  &
-       !$acc         present ( nzb_v_inner, nzb_v_outer, nzb_diff_v )
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-!
-!--          Compute horizontal diffusion
-             DO  k = 1, nzt
-                IF ( k > nzb_v_outer(j,i) )  THEN
-!
-!--                Interpolate eddy diffusivities on staggered gridpoints
-                   kmxp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
-                   kmxm = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
-
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                         & + ( kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx      &
-                         &   + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy      &
-                         &   - kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx          &
-                         &   - kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy          &
-                         &   ) * ddx                                           &
-                         & + 2.0_wp * (                                        &
-                         &           km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) )   &
-                         &         - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) )   &
-                         &            ) * ddy2
-                ENDIF
-             ENDDO
-
-!
-!--          Wall functions at the left and right walls, respectively
-             DO  k = 1, nzt
-                IF( k > nzb_v_inner(j,i)  .AND.  k <= nzb_v_outer(j,i)  .AND.  &
-                    wall_v(j,i) /= 0.0_wp )  THEN
-
-                   kmxp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
-                   kmxm = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
-                   
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                 + 2.0_wp * (                                  &
-                                       km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) ) &
-                                     - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) ) &
-                                            ) * ddy2                           &
-                                 + (   fxp(j,i) * (                            &
-                                  kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx   &
-                                + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy   &
-                                                  )                            &
-                                     - fxm(j,i) * (                            &
-                                  kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
-                                + kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
-                                                  )                            &
-                                     + wall_v(j,i) * vsus(k,j,i)               &
-                                   ) * ddx
-                ENDIF
-             ENDDO
-
-!
-!--          Compute vertical diffusion. In case of simulating a Prandtl
-!--          layer, index k starts at nzb_v_inner+2.
-             DO  k = 1, nzt_diff
-                IF ( k >= nzb_diff_v(j,i) )  THEN
-!
-!--                Interpolate eddy diffusivities on staggered gridpoints
-                   kmzp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
-                   kmzm = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
-
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                         & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)&
-                         &            + ( w(k,j,i)   - w(k,j-1,i) ) * ddy      &
-                         &            )                                        &
-                         &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)&
-                         &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy    &
-                         &            )                                        &
-                         &   ) * ddzw(k)
-                ENDIF
-             ENDDO
-
-          ENDDO
-       ENDDO
-
-!
-!--    Vertical diffusion at the first grid point above the surface,
-!--    if the momentum flux at the bottom is given by the Prandtl law
-!--    or if it is prescribed by the user.
-!--    Difference quotient of the momentum flux is not formed over
-!--    half of the grid spacing (2.0*ddzw(k)) any more, since the
-!--    comparison with other (LES) models showed that the values of
-!--    the momentum flux becomes too large in this case.
-!--    The term containing w(k-1,..) (see above equation) is removed here
-!--    because the vertical velocity is assumed to be zero at the surface.
-       IF ( use_surface_fluxes )  THEN
-
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-          
-                k = nzb_v_inner(j,i)+1
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmzp = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & + ( kmzp * ( w(k,j,i) - w(k,j-1,i)     ) * ddy         &
-                      &   ) * ddzw(k)                                          &
-                      & + ( kmzp * ( v(k+1,j,i) - v(k,j,i)     ) * ddzu(k+1)   &
-                      &   + vsws(j,i)                                          &
-                      &   ) * ddzw(k)
-             ENDDO
-          ENDDO
-
-       ENDIF
-
-!
-!--    Vertical diffusion at the first gridpoint below the top boundary,
-!--    if the momentum flux at the top is prescribed by the user
-       IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
-
-          k = nzt
-
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmzm = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & - ( kmzm *  ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy        &
-                      &   ) * ddzw(k)                                          &
-                      & + ( -vswst(j,i)                                        &
-                      &   - kmzm * ( v(k,j,i)   - v(k-1,j,i)    ) * ddzu(k)    &
-                      &   ) * ddzw(k)
-             ENDDO
-          ENDDO
-
-       ENDIF
-       !$acc end kernels
-
-    END SUBROUTINE diffusion_v_acc
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_v_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzu, ddzw, km, tend, u, v, vsws, vswst, w
-       
-       USE control_parameters,                                                 &
-           ONLY:  constant_top_momentumflux, use_surface_fluxes, use_top_fluxes
-       
-       USE grid_variables,                                                     &
-           ONLY:  ddx, ddy, ddy2, fxm, fxp, wall_v
-       
-       USE indices,                                                            &
-           ONLY:  nzb, nzb_diff_v, nzb_v_inner, nzb_v_outer, nzt, nzt_diff
-       
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i     !< 
-       INTEGER(iwp) ::  j     !< 
-       INTEGER(iwp) ::  k     !< 
-       REAL(wp)     ::  kmxm  !< 
-       REAL(wp)     ::  kmxp  !< 
-       REAL(wp)     ::  kmzm  !< 
-       REAL(wp)     ::  kmzp  !< 
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  vsus  !< 
-
-!
-!--    Compute horizontal diffusion
-       DO  k = nzb_v_outer(j,i)+1, nzt
-!
-!--       Interpolate eddy diffusivities on staggered gridpoints
-          kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
-          kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
-
-          tend(k,j,i) = tend(k,j,i)                                            &
-                      & + ( kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx         &
-                      &   + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy         &
-                      &   - kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx             &
-                      &   - kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy             &
-                      &   ) * ddx                                              &
-                      & + 2.0_wp * (                                           &
-                      &           km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) )      &
-                      &         - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) )      &
-                      &            ) * ddy2
-       ENDDO
-
-!
-!--    Wall functions at the left and right walls, respectively
-       IF ( wall_v(j,i) /= 0.0_wp )  THEN
-
-!
-!--       Calculate the horizontal momentum flux v'u'
-          CALL wall_fluxes( i, j, nzb_v_inner(j,i)+1, nzb_v_outer(j,i),        &
-                            vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
-
-          DO  k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i)
-             kmxp = 0.25_wp *                                                  &
-                    ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
-             kmxm = 0.25_wp *                                                  &
-                    ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
-
-             tend(k,j,i) = tend(k,j,i)                                         &
-                                 + 2.0_wp * (                                  &
-                                       km(k,j,i)   * ( v(k,j+1,i) - v(k,j,i) ) &
-                                     - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) ) &
-                                            ) * ddy2                           &
-                                 + (   fxp(j,i) * (                            &
-                                  kmxp * ( v(k,j,i+1) - v(k,j,i)     ) * ddx   &
-                                + kmxp * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy   &
-                                                  )                            &
-                                     - fxm(j,i) * (                            &
-                                  kmxm * ( v(k,j,i) - v(k,j,i-1) ) * ddx       &
-                                + kmxm * ( u(k,j,i) - u(k,j-1,i) ) * ddy       &
-                                                  )                            &
-                                     + wall_v(j,i) * vsus(k)                   &
-                                   ) * ddx
-          ENDDO
-       ENDIF
-
-!
-!--    Compute vertical diffusion. In case of simulating a Prandtl layer,
-!--    index k starts at nzb_v_inner+2.
-       DO  k = nzb_diff_v(j,i), nzt_diff
-!
-!--       Interpolate eddy diffusivities on staggered gridpoints
-          kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
-          kmzm = 0.25_wp * ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
-
-          tend(k,j,i) = tend(k,j,i)                                            &
-                      & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)     &
-                      &            + ( w(k,j,i) - w(k,j-1,i) ) * ddy           &
-                      &            )                                           &
-                      &   - kmzm * ( ( v(k,j,i)   - v(k-1,j,i)   ) * ddzu(k)   &
-                      &            + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy       &
-                      &            )                                           &
-                      &   ) * ddzw(k)
-       ENDDO
-
-!
-!--    Vertical diffusion at the first grid point above the surface, if the
-!--    momentum flux at the bottom is given by the Prandtl law or if it is
-!--    prescribed by the user.
-!--    Difference quotient of the momentum flux is not formed over half of
-!--    the grid spacing (2.0*ddzw(k)) any more, since the comparison with 
-!--    other (LES) models showed that the values of the momentum flux becomes
-!--    too large in this case.
-!--    The term containing w(k-1,..) (see above equation) is removed here
-!--    because the vertical velocity is assumed to be zero at the surface.
-       IF ( use_surface_fluxes )  THEN
-          k = nzb_v_inner(j,i)+1
-!
-!--       Interpolate eddy diffusivities on staggered gridpoints
-          kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
-
-          tend(k,j,i) = tend(k,j,i)                                            &
-                      & + ( kmzp * ( w(k,j,i) - w(k,j-1,i)     ) * ddy         &
-                      &   ) * ddzw(k)                                          &
-                      & + ( kmzp * ( v(k+1,j,i) - v(k,j,i)     ) * ddzu(k+1)   &
-                      &   + vsws(j,i)                                          &
-                      &   ) * ddzw(k)
-       ENDIF
-
-!
-!--    Vertical diffusion at the first gridpoint below the top boundary,
-!--    if the momentum flux at the top is prescribed by the user
-       IF ( use_top_fluxes  .AND.  constant_top_momentumflux )  THEN
-          k = nzt
-!
-!--       Interpolate eddy diffusivities on staggered gridpoints
-          kmzm = 0.25_wp * &
-                 ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
-
-          tend(k,j,i) = tend(k,j,i)                                            &
-                      & - ( kmzm *  ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy        &
-                      &   ) * ddzw(k)                                          &
-                      & + ( -vswst(j,i)                                        &
-                      &   - kmzm * ( v(k,j,i)   - v(k-1,j,i)    ) * ddzu(k)    &
-                      &   ) * ddzw(k)
-       ENDIF
-
-    END SUBROUTINE diffusion_v_ij
-
- END MODULE diffusion_v_mod
Index: /palm/trunk/SOURCE/diffusion_w.f90
===================================================================
--- /palm/trunk/SOURCE/diffusion_w.f90	(revision 1873)
+++ /palm/trunk/SOURCE/diffusion_w.f90	(revision 1873)
@@ -0,0 +1,487 @@
+!> @file diffusion_w.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1374 2014-04-25 12:55:07Z raasch
+! vsws + vswst removed from acc-present-list
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute 
+! 
+! 1340 2014-03-25 19:45:13Z kanani
+! REAL constants defined as wp-kind
+!
+! 1322 2014-03-20 16:38:49Z raasch
+! REAL constants defined as wp-kind
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements, 
+! kinds are defined in new module kinds, 
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements 
+!
+! 1257 2013-11-08 15:18:40Z raasch
+! openacc loop and loop vector clauses removed, declare create moved after
+! the FORTRAN declaration statement
+!
+! 1128 2013-04-12 06:19:32Z raasch
+! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
+! j_north
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1015 2012-09-27 09:23:24Z raasch
+! accelerator version (*_acc) added
+!
+! 1001 2012-09-13 14:08:46Z raasch
+! arrays comunicated by module instead of parameter list
+!
+! 978 2012-08-09 08:28:32Z fricke
+! outflow damping layer removed
+! kmxm_x/_z and kmxp_x/_z change to kmxm and kmxp
+! kmym_y/_z and kmyp_y/_z change to kmym and kmyp
+!
+! Revision 1.1  1997/09/12 06:24:11  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Diffusion term of the w-component
+!------------------------------------------------------------------------------!
+ MODULE diffusion_w_mod
+ 
+
+    USE wall_fluxes_mod,                                                       &
+        ONLY :  wall_fluxes, wall_fluxes_acc
+
+    PRIVATE
+    PUBLIC diffusion_w, diffusion_w_acc
+
+    INTERFACE diffusion_w
+       MODULE PROCEDURE diffusion_w
+       MODULE PROCEDURE diffusion_w_ij
+    END INTERFACE diffusion_w
+
+    INTERFACE diffusion_w_acc
+       MODULE PROCEDURE diffusion_w_acc
+    END INTERFACE diffusion_w_acc
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_w
+
+       USE arrays_3d,                                                          &          
+           ONLY :  ddzu, ddzw, km, tend, u, v, w
+           
+       USE control_parameters,                                                 & 
+           ONLY :  topography
+           
+       USE grid_variables,                                                     &     
+           ONLY :  ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
+           
+       USE indices,                                                            &            
+           ONLY :  nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
+           
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i     !<
+       INTEGER(iwp) ::  j     !<
+       INTEGER(iwp) ::  k     !<
+       
+       REAL(wp) ::  kmxm  !<
+       REAL(wp) ::  kmxp  !<
+       REAL(wp) ::  kmym  !<
+       REAL(wp) ::  kmyp  !< 
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus  !<
+       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsvs  !<
+
+
+!
+!--    First calculate horizontal momentum flux w'u' and/or w'v' at vertical
+!--    walls, if neccessary
+       IF ( topography /= 'flat' )  THEN
+          CALL wall_fluxes( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, nzb_w_inner,             &
+                            nzb_w_outer, wall_w_x )
+          CALL wall_fluxes( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, nzb_w_inner,             &
+                            nzb_w_outer, wall_w_y )
+       ENDIF
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_w_outer(j,i)+1, nzt-1
+!
+!--             Interpolate eddy diffusivities on staggered gridpoints
+                kmxp = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+                kmxm = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+                kmyp = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+                kmym = 0.25_wp *                                               &
+                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+
+                tend(k,j,i) = tend(k,j,i)                                      &
+                      & + ( kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
+                      &   + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
+                      &   - kmxm * ( w(k,j,i)   - w(k,j,i-1) ) * ddx           &
+                      &   - kmxm * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)     &
+                      &   ) * ddx                                              &
+                      & + ( kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
+                      &   + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
+                      &   - kmym * ( w(k,j,i)   - w(k,j-1,i) ) * ddy           &
+                      &   - kmym * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)     &
+                      &   ) * ddy                                              &
+                      & + 2.0_wp * (                                           &
+                      &   km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)  &
+                      & - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)  &
+                      &            ) * ddzu(k+1)
+             ENDDO
+
+!
+!--          Wall functions at all vertical walls, where necessary
+             IF ( wall_w_x(j,i) /= 0.0_wp  .OR.  wall_w_y(j,i) /= 0.0_wp )  THEN
+
+                DO  k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
+!
+!--                Interpolate eddy diffusivities on staggered gridpoints
+                   kmxp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+                   kmxm = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+                   kmyp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+                   kmym = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                 + (   fwxp(j,i) * (                           &
+                            kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
+                          + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
+                                                   )                           &
+                                     - fwxm(j,i) * (                           &
+                            kmxm * ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
+                          + kmxm * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
+                                                   )                           &
+                                     + wall_w_x(j,i) * wsus(k,j,i)             &
+                                   ) * ddx                                     &
+                                 + (   fwyp(j,i) * (                           &
+                            kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
+                          + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
+                                                   )                           &
+                                     - fwym(j,i) * (                           &
+                            kmym * ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
+                          + kmym * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
+                                                   )                           &
+                                     + wall_w_y(j,i) * wsvs(k,j,i)             &
+                                   ) * ddy                                     &
+                                 + 2.0_wp * (                                  &
+                           km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
+                         - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
+                                            ) * ddzu(k+1)
+                ENDDO
+             ENDIF
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE diffusion_w
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_w_acc
+
+       USE arrays_3d,                                                          &
+           ONLY :  ddzu, ddzw, km, tend, u, v, w
+           
+       USE control_parameters,                                                 &
+           ONLY :  topography
+           
+       USE grid_variables,                                                     &
+           ONLY : ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
+           
+       USE indices,                                                            &
+           ONLY :  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb, &
+                   nzb_w_inner, nzb_w_outer, nzt
+                   
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i     !<
+       INTEGER(iwp) ::  j     !<
+       INTEGER(iwp) ::  k     !<
+       
+       REAL(wp) ::  kmxm  !<
+       REAL(wp) ::  kmxp  !<
+       REAL(wp) ::  kmym  !<
+       REAL(wp) ::  kmyp  !< 
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus  !<
+       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsvs  !<
+       !$acc declare create ( wsus, wsvs )
+
+!
+!--    First calculate horizontal momentum flux w'u' and/or w'v' at vertical
+!--    walls, if neccessary
+       IF ( topography /= 'flat' )  THEN
+          CALL wall_fluxes_acc( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp,          &
+                                nzb_w_inner, nzb_w_outer, wall_w_x )
+          CALL wall_fluxes_acc( wsvs, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp,          &
+                                nzb_w_inner, nzb_w_outer, wall_w_y )
+       ENDIF
+
+       !$acc kernels present ( u, v, w, km, tend )                             &
+       !$acc         present ( ddzu, ddzw, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y )           &
+       !$acc         present ( nzb_w_inner, nzb_w_outer )
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+             DO  k = 1, nzt
+                IF ( k > nzb_w_outer(j,i) )  THEN
+!
+!--                Interpolate eddy diffusivities on staggered gridpoints
+                   kmxp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+                   kmxm = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+                   kmyp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+                   kmym = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+
+                   tend(k,j,i) = tend(k,j,i)                                     &
+                         & + ( kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx        &
+                         &   + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)  &
+                         &   - kmxm * ( w(k,j,i)   - w(k,j,i-1) ) * ddx          &
+                         &   - kmxm * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)    &
+                         &   ) * ddx                                             &
+                         & + ( kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy        &
+                         &   + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)  &
+                         &   - kmym * ( w(k,j,i)   - w(k,j-1,i) ) * ddy          &
+                         &   - kmym * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)    &
+                         &   ) * ddy                                             &
+                         & + 2.0_wp * (                                          &
+                         &   km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
+                         & - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
+                         &            ) * ddzu(k+1)
+                ENDIF
+             ENDDO
+
+!
+!--          Wall functions at all vertical walls, where necessary
+             DO  k = 1,nzt
+
+                IF ( k > nzb_w_inner(j,i)  .AND.  k <= nzb_w_outer(j,i)  .AND. &
+                     wall_w_x(j,i) /= 0.0_wp  .AND.  wall_w_y(j,i) /= 0.0_wp )  THEN
+!
+!--                Interpolate eddy diffusivities on staggered gridpoints
+                   kmxp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+                   kmxm = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+                   kmyp = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+                   kmym = 0.25_wp *                                            &
+                          ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                 + (   fwxp(j,i) * (                           &
+                            kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
+                          + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
+                                                   )                           &
+                                     - fwxm(j,i) * (                           &
+                            kmxm * ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
+                          + kmxm * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
+                                                   )                           &
+                                     + wall_w_x(j,i) * wsus(k,j,i)             &
+                                   ) * ddx                                     &
+                                 + (   fwyp(j,i) * (                           &
+                            kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
+                          + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
+                                                   )                           &
+                                     - fwym(j,i) * (                           &
+                            kmym * ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
+                          + kmym * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
+                                                   )                           &
+                                     + wall_w_y(j,i) * wsvs(k,j,i)             &
+                                   ) * ddy                                     &
+                                 + 2.0_wp * (                                  &
+                           km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
+                         - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
+                                            ) * ddzu(k+1)
+                ENDIF
+             ENDDO
+
+          ENDDO
+       ENDDO
+       !$acc end kernels
+
+    END SUBROUTINE diffusion_w_acc
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_w_ij( i, j )
+
+       USE arrays_3d,                                                          &          
+           ONLY :  ddzu, ddzw, km, tend, u, v, w
+           
+       USE control_parameters,                                                 & 
+           ONLY :  topography
+           
+       USE grid_variables,                                                     &     
+           ONLY :  ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
+           
+       USE indices,                                                            &            
+           ONLY :  nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
+           
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i     !<
+       INTEGER(iwp) ::  j     !<
+       INTEGER(iwp) ::  k     !<
+       
+       REAL(wp) ::  kmxm  !<
+       REAL(wp) ::  kmxp  !<
+       REAL(wp) ::  kmym  !<
+       REAL(wp) ::  kmyp  !< 
+
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsus
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsvs
+
+
+       DO  k = nzb_w_outer(j,i)+1, nzt-1
+!
+!--       Interpolate eddy diffusivities on staggered gridpoints
+          kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+          kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+          kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+          kmym = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+
+          tend(k,j,i) = tend(k,j,i)                                            &
+                      & + ( kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
+                      &   + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
+                      &   - kmxm * ( w(k,j,i)   - w(k,j,i-1) ) * ddx           &
+                      &   - kmxm * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)     &
+                      &   ) * ddx                                              &
+                      & + ( kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
+                      &   + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
+                      &   - kmym * ( w(k,j,i)   - w(k,j-1,i) ) * ddy           &
+                      &   - kmym * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)     &
+                      &   ) * ddy                                              &
+                      & + 2.0_wp * (                                           &
+                      &   km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)  &
+                      & - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)  &
+                      &            ) * ddzu(k+1)
+       ENDDO
+
+!
+!--    Wall functions at all vertical walls, where necessary
+       IF ( wall_w_x(j,i) /= 0.0_wp  .OR.  wall_w_y(j,i) /= 0.0_wp )  THEN
+
+!
+!--       Calculate the horizontal momentum fluxes w'u' and/or w'v'
+          IF ( wall_w_x(j,i) /= 0.0_wp )  THEN
+             CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i),     &
+                               wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
+          ELSE
+             wsus = 0.0_wp
+          ENDIF
+
+          IF ( wall_w_y(j,i) /= 0.0_wp )  THEN
+             CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i),     &
+                               wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
+          ELSE
+             wsvs = 0.0_wp
+          ENDIF
+
+          DO  k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
+!
+!--          Interpolate eddy diffusivities on staggered gridpoints
+             kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+             kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+             kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+             kmym = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+
+             tend(k,j,i) = tend(k,j,i)                                         &
+                                 + (   fwxp(j,i) * (                           &
+                            kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
+                          + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
+                                                   )                           &
+                                     - fwxm(j,i) * (                           &
+                            kmxm * ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
+                          + kmxm * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
+                                                   )                           &
+                                     + wall_w_x(j,i) * wsus(k)                 &
+                                   ) * ddx                                     &
+                                 + (   fwyp(j,i) * (                           &
+                            kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
+                          + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
+                                                   )                           &
+                                     - fwym(j,i) * (                           &
+                            kmym * ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
+                          + kmym * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
+                                                   )                           &
+                                     + wall_w_y(j,i) * wsvs(k)                 &
+                                   ) * ddy                                     &
+                                 + 2.0_wp * (                                  &
+                           km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
+                         - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
+                                            ) * ddzu(k+1)
+          ENDDO
+       ENDIF
+
+    END SUBROUTINE diffusion_w_ij
+
+ END MODULE diffusion_w_mod
Index: lm/trunk/SOURCE/diffusion_w_mod.f90
===================================================================
--- /palm/trunk/SOURCE/diffusion_w_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,486 +1,0 @@
-!> @file diffusion_w_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1374 2014-04-25 12:55:07Z raasch
-! vsws + vswst removed from acc-present-list
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute 
-! 
-! 1340 2014-03-25 19:45:13Z kanani
-! REAL constants defined as wp-kind
-!
-! 1322 2014-03-20 16:38:49Z raasch
-! REAL constants defined as wp-kind
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements, 
-! kinds are defined in new module kinds, 
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements 
-!
-! 1257 2013-11-08 15:18:40Z raasch
-! openacc loop and loop vector clauses removed, declare create moved after
-! the FORTRAN declaration statement
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! accelerator version (*_acc) added
-!
-! 1001 2012-09-13 14:08:46Z raasch
-! arrays comunicated by module instead of parameter list
-!
-! 978 2012-08-09 08:28:32Z fricke
-! outflow damping layer removed
-! kmxm_x/_z and kmxp_x/_z change to kmxm and kmxp
-! kmym_y/_z and kmyp_y/_z change to kmym and kmyp
-!
-! Revision 1.1  1997/09/12 06:24:11  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Diffusion term of the w-component
-!------------------------------------------------------------------------------!
- MODULE diffusion_w_mod
- 
-
-    USE wall_fluxes_mod,                                                       &
-        ONLY :  wall_fluxes, wall_fluxes_acc
-
-    PRIVATE
-    PUBLIC diffusion_w, diffusion_w_acc
-
-    INTERFACE diffusion_w
-       MODULE PROCEDURE diffusion_w
-       MODULE PROCEDURE diffusion_w_ij
-    END INTERFACE diffusion_w
-
-    INTERFACE diffusion_w_acc
-       MODULE PROCEDURE diffusion_w_acc
-    END INTERFACE diffusion_w_acc
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_w
-
-       USE arrays_3d,                                                          &          
-           ONLY :  ddzu, ddzw, km, tend, u, v, w
-           
-       USE control_parameters,                                                 & 
-           ONLY :  topography
-           
-       USE grid_variables,                                                     &     
-           ONLY :  ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
-           
-       USE indices,                                                            &            
-           ONLY :  nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
-           
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i     !<
-       INTEGER(iwp) ::  j     !<
-       INTEGER(iwp) ::  k     !<
-       
-       REAL(wp) ::  kmxm  !<
-       REAL(wp) ::  kmxp  !<
-       REAL(wp) ::  kmym  !<
-       REAL(wp) ::  kmyp  !< 
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus  !<
-       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsvs  !<
-
-
-!
-!--    First calculate horizontal momentum flux w'u' and/or w'v' at vertical
-!--    walls, if neccessary
-       IF ( topography /= 'flat' )  THEN
-          CALL wall_fluxes( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, nzb_w_inner,             &
-                            nzb_w_outer, wall_w_x )
-          CALL wall_fluxes( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, nzb_w_inner,             &
-                            nzb_w_outer, wall_w_y )
-       ENDIF
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_w_outer(j,i)+1, nzt-1
-!
-!--             Interpolate eddy diffusivities on staggered gridpoints
-                kmxp = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
-                kmxm = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
-                kmyp = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
-                kmym = 0.25_wp *                                               &
-                       ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
-
-                tend(k,j,i) = tend(k,j,i)                                      &
-                      & + ( kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
-                      &   + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
-                      &   - kmxm * ( w(k,j,i)   - w(k,j,i-1) ) * ddx           &
-                      &   - kmxm * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)     &
-                      &   ) * ddx                                              &
-                      & + ( kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
-                      &   + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
-                      &   - kmym * ( w(k,j,i)   - w(k,j-1,i) ) * ddy           &
-                      &   - kmym * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)     &
-                      &   ) * ddy                                              &
-                      & + 2.0_wp * (                                           &
-                      &   km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)  &
-                      & - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)  &
-                      &            ) * ddzu(k+1)
-             ENDDO
-
-!
-!--          Wall functions at all vertical walls, where necessary
-             IF ( wall_w_x(j,i) /= 0.0_wp  .OR.  wall_w_y(j,i) /= 0.0_wp )  THEN
-
-                DO  k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
-!
-!--                Interpolate eddy diffusivities on staggered gridpoints
-                   kmxp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
-                   kmxm = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
-                   kmyp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
-                   kmym = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
-
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                 + (   fwxp(j,i) * (                           &
-                            kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
-                          + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
-                                                   )                           &
-                                     - fwxm(j,i) * (                           &
-                            kmxm * ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
-                          + kmxm * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
-                                                   )                           &
-                                     + wall_w_x(j,i) * wsus(k,j,i)             &
-                                   ) * ddx                                     &
-                                 + (   fwyp(j,i) * (                           &
-                            kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
-                          + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
-                                                   )                           &
-                                     - fwym(j,i) * (                           &
-                            kmym * ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
-                          + kmym * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
-                                                   )                           &
-                                     + wall_w_y(j,i) * wsvs(k,j,i)             &
-                                   ) * ddy                                     &
-                                 + 2.0_wp * (                                  &
-                           km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
-                         - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
-                                            ) * ddzu(k+1)
-                ENDDO
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE diffusion_w
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_w_acc
-
-       USE arrays_3d,                                                          &
-           ONLY :  ddzu, ddzw, km, tend, u, v, w
-           
-       USE control_parameters,                                                 &
-           ONLY :  topography
-           
-       USE grid_variables,                                                     &
-           ONLY : ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
-           
-       USE indices,                                                            &
-           ONLY :  i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb, &
-                   nzb_w_inner, nzb_w_outer, nzt
-                   
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i     !<
-       INTEGER(iwp) ::  j     !<
-       INTEGER(iwp) ::  k     !<
-       
-       REAL(wp) ::  kmxm  !<
-       REAL(wp) ::  kmxp  !<
-       REAL(wp) ::  kmym  !<
-       REAL(wp) ::  kmyp  !< 
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus  !<
-       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsvs  !<
-       !$acc declare create ( wsus, wsvs )
-
-!
-!--    First calculate horizontal momentum flux w'u' and/or w'v' at vertical
-!--    walls, if neccessary
-       IF ( topography /= 'flat' )  THEN
-          CALL wall_fluxes_acc( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp,          &
-                                nzb_w_inner, nzb_w_outer, wall_w_x )
-          CALL wall_fluxes_acc( wsvs, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp,          &
-                                nzb_w_inner, nzb_w_outer, wall_w_y )
-       ENDIF
-
-       !$acc kernels present ( u, v, w, km, tend )                             &
-       !$acc         present ( ddzu, ddzw, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y )           &
-       !$acc         present ( nzb_w_inner, nzb_w_outer )
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-             DO  k = 1, nzt
-                IF ( k > nzb_w_outer(j,i) )  THEN
-!
-!--                Interpolate eddy diffusivities on staggered gridpoints
-                   kmxp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
-                   kmxm = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
-                   kmyp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
-                   kmym = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
-
-                   tend(k,j,i) = tend(k,j,i)                                     &
-                         & + ( kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx        &
-                         &   + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)  &
-                         &   - kmxm * ( w(k,j,i)   - w(k,j,i-1) ) * ddx          &
-                         &   - kmxm * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)    &
-                         &   ) * ddx                                             &
-                         & + ( kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy        &
-                         &   + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)  &
-                         &   - kmym * ( w(k,j,i)   - w(k,j-1,i) ) * ddy          &
-                         &   - kmym * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)    &
-                         &   ) * ddy                                             &
-                         & + 2.0_wp * (                                          &
-                         &   km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
-                         & - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
-                         &            ) * ddzu(k+1)
-                ENDIF
-             ENDDO
-
-!
-!--          Wall functions at all vertical walls, where necessary
-             DO  k = 1,nzt
-
-                IF ( k > nzb_w_inner(j,i)  .AND.  k <= nzb_w_outer(j,i)  .AND. &
-                     wall_w_x(j,i) /= 0.0_wp  .AND.  wall_w_y(j,i) /= 0.0_wp )  THEN
-!
-!--                Interpolate eddy diffusivities on staggered gridpoints
-                   kmxp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
-                   kmxm = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
-                   kmyp = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
-                   kmym = 0.25_wp *                                            &
-                          ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
-
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                 + (   fwxp(j,i) * (                           &
-                            kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
-                          + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
-                                                   )                           &
-                                     - fwxm(j,i) * (                           &
-                            kmxm * ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
-                          + kmxm * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
-                                                   )                           &
-                                     + wall_w_x(j,i) * wsus(k,j,i)             &
-                                   ) * ddx                                     &
-                                 + (   fwyp(j,i) * (                           &
-                            kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
-                          + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
-                                                   )                           &
-                                     - fwym(j,i) * (                           &
-                            kmym * ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
-                          + kmym * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
-                                                   )                           &
-                                     + wall_w_y(j,i) * wsvs(k,j,i)             &
-                                   ) * ddy                                     &
-                                 + 2.0_wp * (                                  &
-                           km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
-                         - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
-                                            ) * ddzu(k+1)
-                ENDIF
-             ENDDO
-
-          ENDDO
-       ENDDO
-       !$acc end kernels
-
-    END SUBROUTINE diffusion_w_acc
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_w_ij( i, j )
-
-       USE arrays_3d,                                                          &          
-           ONLY :  ddzu, ddzw, km, tend, u, v, w
-           
-       USE control_parameters,                                                 & 
-           ONLY :  topography
-           
-       USE grid_variables,                                                     &     
-           ONLY :  ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y
-           
-       USE indices,                                                            &            
-           ONLY :  nxl, nxr, nyn, nys, nzb, nzb_w_inner, nzb_w_outer, nzt
-           
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i     !<
-       INTEGER(iwp) ::  j     !<
-       INTEGER(iwp) ::  k     !<
-       
-       REAL(wp) ::  kmxm  !<
-       REAL(wp) ::  kmxp  !<
-       REAL(wp) ::  kmym  !<
-       REAL(wp) ::  kmyp  !< 
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsus
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsvs
-
-
-       DO  k = nzb_w_outer(j,i)+1, nzt-1
-!
-!--       Interpolate eddy diffusivities on staggered gridpoints
-          kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
-          kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
-          kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
-          kmym = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
-
-          tend(k,j,i) = tend(k,j,i)                                            &
-                      & + ( kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
-                      &   + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
-                      &   - kmxm * ( w(k,j,i)   - w(k,j,i-1) ) * ddx           &
-                      &   - kmxm * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)     &
-                      &   ) * ddx                                              &
-                      & + ( kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
-                      &   + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
-                      &   - kmym * ( w(k,j,i)   - w(k,j-1,i) ) * ddy           &
-                      &   - kmym * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)     &
-                      &   ) * ddy                                              &
-                      & + 2.0_wp * (                                           &
-                      &   km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)  &
-                      & - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k)  &
-                      &            ) * ddzu(k+1)
-       ENDDO
-
-!
-!--    Wall functions at all vertical walls, where necessary
-       IF ( wall_w_x(j,i) /= 0.0_wp  .OR.  wall_w_y(j,i) /= 0.0_wp )  THEN
-
-!
-!--       Calculate the horizontal momentum fluxes w'u' and/or w'v'
-          IF ( wall_w_x(j,i) /= 0.0_wp )  THEN
-             CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i),     &
-                               wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
-          ELSE
-             wsus = 0.0_wp
-          ENDIF
-
-          IF ( wall_w_y(j,i) /= 0.0_wp )  THEN
-             CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i),     &
-                               wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
-          ELSE
-             wsvs = 0.0_wp
-          ENDIF
-
-          DO  k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
-!
-!--          Interpolate eddy diffusivities on staggered gridpoints
-             kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
-             kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
-             kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
-             kmym = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
-
-             tend(k,j,i) = tend(k,j,i)                                         &
-                                 + (   fwxp(j,i) * (                           &
-                            kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
-                          + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
-                                                   )                           &
-                                     - fwxm(j,i) * (                           &
-                            kmxm * ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
-                          + kmxm * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
-                                                   )                           &
-                                     + wall_w_x(j,i) * wsus(k)                 &
-                                   ) * ddx                                     &
-                                 + (   fwyp(j,i) * (                           &
-                            kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
-                          + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
-                                                   )                           &
-                                     - fwym(j,i) * (                           &
-                            kmym * ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
-                          + kmym * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
-                                                   )                           &
-                                     + wall_w_y(j,i) * wsvs(k)                 &
-                                   ) * ddy                                     &
-                                 + 2.0_wp * (                                  &
-                           km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
-                         - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
-                                            ) * ddzu(k+1)
-          ENDDO
-       ENDIF
-
-    END SUBROUTINE diffusion_w_ij
-
- END MODULE diffusion_w_mod
Index: /palm/trunk/SOURCE/eqn_state_seawater.f90
===================================================================
--- /palm/trunk/SOURCE/eqn_state_seawater.f90	(revision 1873)
+++ /palm/trunk/SOURCE/eqn_state_seawater.f90	(revision 1873)
@@ -0,0 +1,318 @@
+!> @file eqn_state_seawater.f90
+!------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute 
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements, 
+! kinds are defined in new module kinds, 
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements 
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Equation of state for seawater as a function of potential temperature,
+!> salinity, and pressure.
+!> For coefficients see Jackett et al., 2006: J. Atm. Ocean Tech.
+!> eqn_state_seawater calculates the potential density referred at hyp(0).
+!> eqn_state_seawater_func calculates density.
+!------------------------------------------------------------------------------!
+ MODULE eqn_state_seawater_mod
+ 
+    
+    USE kinds
+
+    IMPLICIT NONE
+
+    PRIVATE
+    PUBLIC eqn_state_seawater, eqn_state_seawater_func
+
+    REAL(wp), DIMENSION(12), PARAMETER ::  nom =                               &
+                          (/ 9.9984085444849347D2,   7.3471625860981584D0,     &
+                            -5.3211231792841769D-2,  3.6492439109814549D-4,    &
+                             2.5880571023991390D0,  -6.7168282786692354D-3,    &
+                             1.9203202055760151D-3,  1.1798263740430364D-2,    &
+                             9.8920219266399117D-8,  4.6996642771754730D-6,    &
+                            -2.5862187075154352D-8, -3.2921414007960662D-12 /)
+                          !<
+
+    REAL(wp), DIMENSION(13), PARAMETER ::  den =                               &
+                          (/ 1.0D0,                  7.2815210113327091D-3,    &
+                            -4.4787265461983921D-5,  3.3851002965802430D-7,    &
+                             1.3651202389758572D-10, 1.7632126669040377D-3,    &
+                            -8.8066583251206474D-6, -1.8832689434804897D-10,   &
+                             5.7463776745432097D-6,  1.4716275472242334D-9,    &
+                             6.7103246285651894D-6, -2.4461698007024582D-17,   &
+                            -9.1534417604289062D-18 /)
+                          !<
+
+    INTERFACE eqn_state_seawater
+       MODULE PROCEDURE eqn_state_seawater
+       MODULE PROCEDURE eqn_state_seawater_ij
+    END INTERFACE eqn_state_seawater
+ 
+    INTERFACE eqn_state_seawater_func
+       MODULE PROCEDURE eqn_state_seawater_func
+    END INTERFACE eqn_state_seawater_func
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE eqn_state_seawater
+
+       USE arrays_3d,                                                          &
+           ONLY:  hyp, prho, pt_p, rho, sa_p
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nys, nzb_s_inner, nzt
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i  !<
+       INTEGER(iwp) ::  j  !<
+       INTEGER(iwp) ::  k  !<
+
+       REAL(wp) ::  pden  !<
+       REAL(wp) ::  pnom  !<
+       REAL(wp) ::  p1    !<
+       REAL(wp) ::  p2    !<
+       REAL(wp) ::  p3    !<
+       REAL(wp) ::  pt1   !<
+       REAL(wp) ::  pt2   !<
+       REAL(wp) ::  pt3   !<
+       REAL(wp) ::  pt4   !<
+       REAL(wp) ::  sa1   !<
+       REAL(wp) ::  sa15  !<
+       REAL(wp) ::  sa2   !<
+       
+                       
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_s_inner(j,i)+1, nzt
+!
+!--             Pressure is needed in dbar
+                p1 = hyp(k) * 1E-4_wp
+                p2 = p1 * p1
+                p3 = p2 * p1
+
+!
+!--             Temperature needed in degree Celsius
+                pt1 = pt_p(k,j,i) - 273.15_wp
+                pt2 = pt1 * pt1
+                pt3 = pt1 * pt2
+                pt4 = pt2 * pt2
+
+                sa1  = sa_p(k,j,i)
+                sa15 = sa1 * SQRT( sa1 )
+                sa2  = sa1 * sa1
+
+                pnom = nom(1)           + nom(2)*pt1     + nom(3)*pt2     +    &
+                       nom(4)*pt3       + nom(5)*sa1     + nom(6)*sa1*pt1 +    &
+                       nom(7)*sa2
+
+                pden = den(1)           + den(2)*pt1     + den(3)*pt2     +    &
+                       den(4)*pt3       + den(5)*pt4     + den(6)*sa1     +    &
+                       den(7)*sa1*pt1   + den(8)*sa1*pt3 + den(9)*sa15    +    &
+                       den(10)*sa15*pt2
+
+!
+!--             Potential density (without pressure terms)
+                prho(k,j,i) = pnom / pden
+
+                pnom = pnom +             nom(8)*p1      + nom(9)*p1*pt2  +    &
+                       nom(10)*p1*sa1   + nom(11)*p2     + nom(12)*p2*pt2
+
+                pden = pden +             den(11)*p1     + den(12)*p2*pt3 +    &
+                       den(13)*p3*pt1
+
+!
+!--             In-situ density
+                rho(k,j,i) = pnom / pden
+
+             ENDDO
+!
+!--          Neumann conditions are assumed at bottom and top boundary
+             prho(nzt+1,j,i)            = prho(nzt,j,i)
+             prho(nzb_s_inner(j,i),j,i) = prho(nzb_s_inner(j,i)+1,j,i)
+             rho(nzt+1,j,i)             = rho(nzt,j,i)
+             rho(nzb_s_inner(j,i),j,i)  = rho(nzb_s_inner(j,i)+1,j,i)
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE eqn_state_seawater
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE eqn_state_seawater_ij( i, j )
+
+       USE arrays_3d,                                                          &
+           ONLY:  hyp, prho, pt_p, rho, sa_p
+           
+       USE indices,                                                            &
+           ONLY:  nzb_s_inner, nzt
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i, j, k
+
+       REAL(wp)     ::  pden, pnom, p1, p2, p3, pt1, pt2, pt3, pt4, sa1, sa15, &
+                        sa2
+
+       DO  k = nzb_s_inner(j,i)+1, nzt
+!
+!--       Pressure is needed in dbar
+          p1 = hyp(k) * 1E-4_wp
+          p2 = p1 * p1
+          p3 = p2 * p1
+
+!
+!--       Temperature needed in degree Celsius
+          pt1 = pt_p(k,j,i) - 273.15_wp
+          pt2 = pt1 * pt1
+          pt3 = pt1 * pt2
+          pt4 = pt2 * pt2
+
+          sa1  = sa_p(k,j,i)
+          sa15 = sa1 * SQRT( sa1 )
+          sa2  = sa1 * sa1
+
+          pnom = nom(1)           + nom(2)*pt1     + nom(3)*pt2     +          &
+                 nom(4)*pt3       + nom(5)*sa1     + nom(6)*sa1*pt1 +          &
+                 nom(7)*sa2
+
+          pden = den(1)           + den(2)*pt1     + den(3)*pt2     +          &
+                 den(4)*pt3       + den(5)*pt4     + den(6)*sa1     +          &
+                 den(7)*sa1*pt1   + den(8)*sa1*pt3 + den(9)*sa15    +          &
+                 den(10)*sa15*pt2
+
+!
+!--       Potential density (without pressure terms)
+          prho(k,j,i) = pnom / pden
+
+          pnom = pnom +             nom(8)*p1      + nom(9)*p1*pt2  +          &
+                 nom(10)*p1*sa1   + nom(11)*p2     + nom(12)*p2*pt2
+          pden = pden +             den(11)*p1     + den(12)*p2*pt3 +          &
+                 den(13)*p3*pt1
+
+!
+!--       In-situ density
+          rho(k,j,i) = pnom / pden
+
+
+       ENDDO
+
+!
+!--    Neumann conditions are assumed at bottom and top boundary
+       prho(nzt+1,j,i)            = prho(nzt,j,i)
+       prho(nzb_s_inner(j,i),j,i) = prho(nzb_s_inner(j,i)+1,j,i)
+       rho(nzt+1,j,i)             = rho(nzt,j,i)
+       rho(nzb_s_inner(j,i),j,i)  = rho(nzb_s_inner(j,i)+1,j,i)
+
+    END SUBROUTINE eqn_state_seawater_ij
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Equation of state as a function
+!------------------------------------------------------------------------------!
+    REAL(wp) FUNCTION eqn_state_seawater_func( p, pt, sa )
+
+       IMPLICIT NONE
+
+       REAL(wp) ::  p      !<
+       REAL(wp) ::  p1     !<
+       REAL(wp) ::  p2     !<
+       REAL(wp) ::  p3     !<
+       REAL(wp) ::  pt     !<
+       REAL(wp) ::  pt1    !<
+       REAL(wp) ::  pt2    !<
+       REAL(wp) ::  pt3    !<
+       REAL(wp) ::  pt4    !<
+       REAL(wp) ::  sa     !<
+       REAL(wp) ::  sa15   !<
+       REAL(wp) ::  sa2    !<
+
+!
+!--    Pressure is needed in dbar
+       p1 = p  * 1E-4_wp
+       p2 = p1 * p1
+       p3 = p2 * p1
+
+!
+!--    Temperature needed in degree Celsius
+       pt1 = pt - 273.15_wp
+       pt2 = pt1 * pt1
+       pt3 = pt1 * pt2
+       pt4 = pt2 * pt2
+
+       sa15 = sa * SQRT( sa )
+       sa2  = sa * sa
+
+
+       eqn_state_seawater_func =                                               &
+         ( nom(1)        + nom(2)*pt1       + nom(3)*pt2    + nom(4)*pt3     + &
+           nom(5)*sa     + nom(6)*sa*pt1    + nom(7)*sa2    + nom(8)*p1      + &
+           nom(9)*p1*pt2 + nom(10)*p1*sa    + nom(11)*p2    + nom(12)*p2*pt2   &
+         ) /                                                                   &
+         ( den(1)        + den(2)*pt1       + den(3)*pt2    + den(4)*pt3     + &
+           den(5)*pt4    + den(6)*sa        + den(7)*sa*pt1 + den(8)*sa*pt3  + &
+           den(9)*sa15   + den(10)*sa15*pt2 + den(11)*p1    + den(12)*p2*pt3 + &
+           den(13)*p3*pt1                                                      &
+         )
+
+
+    END FUNCTION eqn_state_seawater_func
+
+ END MODULE eqn_state_seawater_mod
Index: lm/trunk/SOURCE/eqn_state_seawater_mod.f90
===================================================================
--- /palm/trunk/SOURCE/eqn_state_seawater_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,317 +1,0 @@
-!> @file eqn_state_seawater_mod.f90
-!------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute 
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements, 
-! kinds are defined in new module kinds, 
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements 
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 97 2007-06-21 08:23:15Z raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Equation of state for seawater as a function of potential temperature,
-!> salinity, and pressure.
-!> For coefficients see Jackett et al., 2006: J. Atm. Ocean Tech.
-!> eqn_state_seawater calculates the potential density referred at hyp(0).
-!> eqn_state_seawater_func calculates density.
-!------------------------------------------------------------------------------!
- MODULE eqn_state_seawater_mod
- 
-    
-    USE kinds
-
-    IMPLICIT NONE
-
-    PRIVATE
-    PUBLIC eqn_state_seawater, eqn_state_seawater_func
-
-    REAL(wp), DIMENSION(12), PARAMETER ::  nom =                               &
-                          (/ 9.9984085444849347D2,   7.3471625860981584D0,     &
-                            -5.3211231792841769D-2,  3.6492439109814549D-4,    &
-                             2.5880571023991390D0,  -6.7168282786692354D-3,    &
-                             1.9203202055760151D-3,  1.1798263740430364D-2,    &
-                             9.8920219266399117D-8,  4.6996642771754730D-6,    &
-                            -2.5862187075154352D-8, -3.2921414007960662D-12 /)
-                          !<
-
-    REAL(wp), DIMENSION(13), PARAMETER ::  den =                               &
-                          (/ 1.0D0,                  7.2815210113327091D-3,    &
-                            -4.4787265461983921D-5,  3.3851002965802430D-7,    &
-                             1.3651202389758572D-10, 1.7632126669040377D-3,    &
-                            -8.8066583251206474D-6, -1.8832689434804897D-10,   &
-                             5.7463776745432097D-6,  1.4716275472242334D-9,    &
-                             6.7103246285651894D-6, -2.4461698007024582D-17,   &
-                            -9.1534417604289062D-18 /)
-                          !<
-
-    INTERFACE eqn_state_seawater
-       MODULE PROCEDURE eqn_state_seawater
-       MODULE PROCEDURE eqn_state_seawater_ij
-    END INTERFACE eqn_state_seawater
- 
-    INTERFACE eqn_state_seawater_func
-       MODULE PROCEDURE eqn_state_seawater_func
-    END INTERFACE eqn_state_seawater_func
- 
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE eqn_state_seawater
-
-       USE arrays_3d,                                                          &
-           ONLY:  hyp, prho, pt_p, rho, sa_p
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nyn, nys, nzb_s_inner, nzt
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i  !<
-       INTEGER(iwp) ::  j  !<
-       INTEGER(iwp) ::  k  !<
-
-       REAL(wp) ::  pden  !<
-       REAL(wp) ::  pnom  !<
-       REAL(wp) ::  p1    !<
-       REAL(wp) ::  p2    !<
-       REAL(wp) ::  p3    !<
-       REAL(wp) ::  pt1   !<
-       REAL(wp) ::  pt2   !<
-       REAL(wp) ::  pt3   !<
-       REAL(wp) ::  pt4   !<
-       REAL(wp) ::  sa1   !<
-       REAL(wp) ::  sa15  !<
-       REAL(wp) ::  sa2   !<
-       
-                       
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_s_inner(j,i)+1, nzt
-!
-!--             Pressure is needed in dbar
-                p1 = hyp(k) * 1E-4_wp
-                p2 = p1 * p1
-                p3 = p2 * p1
-
-!
-!--             Temperature needed in degree Celsius
-                pt1 = pt_p(k,j,i) - 273.15_wp
-                pt2 = pt1 * pt1
-                pt3 = pt1 * pt2
-                pt4 = pt2 * pt2
-
-                sa1  = sa_p(k,j,i)
-                sa15 = sa1 * SQRT( sa1 )
-                sa2  = sa1 * sa1
-
-                pnom = nom(1)           + nom(2)*pt1     + nom(3)*pt2     +    &
-                       nom(4)*pt3       + nom(5)*sa1     + nom(6)*sa1*pt1 +    &
-                       nom(7)*sa2
-
-                pden = den(1)           + den(2)*pt1     + den(3)*pt2     +    &
-                       den(4)*pt3       + den(5)*pt4     + den(6)*sa1     +    &
-                       den(7)*sa1*pt1   + den(8)*sa1*pt3 + den(9)*sa15    +    &
-                       den(10)*sa15*pt2
-
-!
-!--             Potential density (without pressure terms)
-                prho(k,j,i) = pnom / pden
-
-                pnom = pnom +             nom(8)*p1      + nom(9)*p1*pt2  +    &
-                       nom(10)*p1*sa1   + nom(11)*p2     + nom(12)*p2*pt2
-
-                pden = pden +             den(11)*p1     + den(12)*p2*pt3 +    &
-                       den(13)*p3*pt1
-
-!
-!--             In-situ density
-                rho(k,j,i) = pnom / pden
-
-             ENDDO
-!
-!--          Neumann conditions are assumed at bottom and top boundary
-             prho(nzt+1,j,i)            = prho(nzt,j,i)
-             prho(nzb_s_inner(j,i),j,i) = prho(nzb_s_inner(j,i)+1,j,i)
-             rho(nzt+1,j,i)             = rho(nzt,j,i)
-             rho(nzb_s_inner(j,i),j,i)  = rho(nzb_s_inner(j,i)+1,j,i)
-
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE eqn_state_seawater
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE eqn_state_seawater_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  hyp, prho, pt_p, rho, sa_p
-           
-       USE indices,                                                            &
-           ONLY:  nzb_s_inner, nzt
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i, j, k
-
-       REAL(wp)     ::  pden, pnom, p1, p2, p3, pt1, pt2, pt3, pt4, sa1, sa15, &
-                        sa2
-
-       DO  k = nzb_s_inner(j,i)+1, nzt
-!
-!--       Pressure is needed in dbar
-          p1 = hyp(k) * 1E-4_wp
-          p2 = p1 * p1
-          p3 = p2 * p1
-
-!
-!--       Temperature needed in degree Celsius
-          pt1 = pt_p(k,j,i) - 273.15_wp
-          pt2 = pt1 * pt1
-          pt3 = pt1 * pt2
-          pt4 = pt2 * pt2
-
-          sa1  = sa_p(k,j,i)
-          sa15 = sa1 * SQRT( sa1 )
-          sa2  = sa1 * sa1
-
-          pnom = nom(1)           + nom(2)*pt1     + nom(3)*pt2     +          &
-                 nom(4)*pt3       + nom(5)*sa1     + nom(6)*sa1*pt1 +          &
-                 nom(7)*sa2
-
-          pden = den(1)           + den(2)*pt1     + den(3)*pt2     +          &
-                 den(4)*pt3       + den(5)*pt4     + den(6)*sa1     +          &
-                 den(7)*sa1*pt1   + den(8)*sa1*pt3 + den(9)*sa15    +          &
-                 den(10)*sa15*pt2
-
-!
-!--       Potential density (without pressure terms)
-          prho(k,j,i) = pnom / pden
-
-          pnom = pnom +             nom(8)*p1      + nom(9)*p1*pt2  +          &
-                 nom(10)*p1*sa1   + nom(11)*p2     + nom(12)*p2*pt2
-          pden = pden +             den(11)*p1     + den(12)*p2*pt3 +          &
-                 den(13)*p3*pt1
-
-!
-!--       In-situ density
-          rho(k,j,i) = pnom / pden
-
-
-       ENDDO
-
-!
-!--    Neumann conditions are assumed at bottom and top boundary
-       prho(nzt+1,j,i)            = prho(nzt,j,i)
-       prho(nzb_s_inner(j,i),j,i) = prho(nzb_s_inner(j,i)+1,j,i)
-       rho(nzt+1,j,i)             = rho(nzt,j,i)
-       rho(nzb_s_inner(j,i),j,i)  = rho(nzb_s_inner(j,i)+1,j,i)
-
-    END SUBROUTINE eqn_state_seawater_ij
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Equation of state as a function
-!------------------------------------------------------------------------------!
-    REAL(wp) FUNCTION eqn_state_seawater_func( p, pt, sa )
-
-       IMPLICIT NONE
-
-       REAL(wp) ::  p      !<
-       REAL(wp) ::  p1     !<
-       REAL(wp) ::  p2     !<
-       REAL(wp) ::  p3     !<
-       REAL(wp) ::  pt     !<
-       REAL(wp) ::  pt1    !<
-       REAL(wp) ::  pt2    !<
-       REAL(wp) ::  pt3    !<
-       REAL(wp) ::  pt4    !<
-       REAL(wp) ::  sa     !<
-       REAL(wp) ::  sa15   !<
-       REAL(wp) ::  sa2    !<
-
-!
-!--    Pressure is needed in dbar
-       p1 = p  * 1E-4_wp
-       p2 = p1 * p1
-       p3 = p2 * p1
-
-!
-!--    Temperature needed in degree Celsius
-       pt1 = pt - 273.15_wp
-       pt2 = pt1 * pt1
-       pt3 = pt1 * pt2
-       pt4 = pt2 * pt2
-
-       sa15 = sa * SQRT( sa )
-       sa2  = sa * sa
-
-
-       eqn_state_seawater_func =                                               &
-         ( nom(1)        + nom(2)*pt1       + nom(3)*pt2    + nom(4)*pt3     + &
-           nom(5)*sa     + nom(6)*sa*pt1    + nom(7)*sa2    + nom(8)*p1      + &
-           nom(9)*p1*pt2 + nom(10)*p1*sa    + nom(11)*p2    + nom(12)*p2*pt2   &
-         ) /                                                                   &
-         ( den(1)        + den(2)*pt1       + den(3)*pt2    + den(4)*pt3     + &
-           den(5)*pt4    + den(6)*sa        + den(7)*sa*pt1 + den(8)*sa*pt3  + &
-           den(9)*sa15   + den(10)*sa15*pt2 + den(11)*p1    + den(12)*p2*pt3 + &
-           den(13)*p3*pt1                                                      &
-         )
-
-
-    END FUNCTION eqn_state_seawater_func
-
- END MODULE eqn_state_seawater_mod
Index: /palm/trunk/SOURCE/interaction_droplets_ptq.f90
===================================================================
--- /palm/trunk/SOURCE/interaction_droplets_ptq.f90	(revision 1873)
+++ /palm/trunk/SOURCE/interaction_droplets_ptq.f90	(revision 1873)
@@ -0,0 +1,161 @@
+!> @file interaction_droplets_ptq.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1845 2016-04-08 08:29:13Z raasch
+! nzb_2d replaced by nzb_s_inner
+!
+! 1822 2016-04-07 07:49:42Z hoffmann
+! Unused variables removed.
+!
+! 1779 2016-03-03 08:01:28Z raasch
+! bugfix: module procedure names shortened to avoid Intel compiler warnings
+! about too long names
+!
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 799 2011-12-21 17:48:03Z franke
+! Bugfix: pt_d_t(k) was missing in calculation of pt_p
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.1  2005/06/26 19:57:47  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Release of latent heat and change of specific humidity due to condensation /
+!> evaporation of droplets.
+!------------------------------------------------------------------------------!
+ MODULE interaction_droplets_ptq_mod
+ 
+
+    PRIVATE
+    PUBLIC interaction_droplets_ptq
+
+    INTERFACE interaction_droplets_ptq
+!
+!--    Internal names shortened in order ro avoid Intel compiler messages
+!--    about too long names
+       MODULE PROCEDURE i_droplets_ptq
+       MODULE PROCEDURE i_droplets_ptq_ij
+    END INTERFACE interaction_droplets_ptq
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE i_droplets_ptq
+
+       USE arrays_3d,                                                          &
+           ONLY:  pt_p, ql_c, q_p
+           
+       USE cloud_parameters,                                                   &
+           ONLY:  l_d_cp, pt_d_t
+           
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nys, nzb_s_inner, nzt
+           
+       USE kinds
+
+       USE pegrid
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+ 
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                q_p(k,j,i)  = q_p(k,j,i)  - ql_c(k,j,i)
+                pt_p(k,j,i) = pt_p(k,j,i) + l_d_cp * ql_c(k,j,i) * pt_d_t(k)
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE i_droplets_ptq
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE i_droplets_ptq_ij( i, j )
+
+       USE arrays_3d,                                                          &
+           ONLY:  pt_p, ql_c, q_p
+
+       USE cloud_parameters,                                                   &
+           ONLY:  l_d_cp, pt_d_t
+
+       USE indices,                                                            &
+           ONLY:  nzb_s_inner, nzt
+
+       USE kinds,                                                              &
+           ONLY:  iwp, wp
+
+       USE pegrid
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+
+       DO  k = nzb_s_inner(j,i)+1, nzt
+          q_p(k,j,i)  = q_p(k,j,i)  - ql_c(k,j,i)
+          pt_p(k,j,i) = pt_p(k,j,i) + l_d_cp * ql_c(k,j,i) * pt_d_t(k)
+       ENDDO
+
+    END SUBROUTINE i_droplets_ptq_ij
+
+ END MODULE interaction_droplets_ptq_mod
Index: lm/trunk/SOURCE/interaction_droplets_ptq_mod.f90
===================================================================
--- /palm/trunk/SOURCE/interaction_droplets_ptq_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,160 +1,0 @@
-!> @file interaction_droplets_ptq_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1845 2016-04-08 08:29:13Z raasch
-! nzb_2d replaced by nzb_s_inner
-!
-! 1822 2016-04-07 07:49:42Z hoffmann
-! Unused variables removed.
-!
-! 1779 2016-03-03 08:01:28Z raasch
-! bugfix: module procedure names shortened to avoid Intel compiler warnings
-! about too long names
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 799 2011-12-21 17:48:03Z franke
-! Bugfix: pt_d_t(k) was missing in calculation of pt_p
-!
-! RCS Log replace by Id keyword, revision history cleaned up
-!
-! Revision 1.1  2005/06/26 19:57:47  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Release of latent heat and change of specific humidity due to condensation /
-!> evaporation of droplets.
-!------------------------------------------------------------------------------!
- MODULE interaction_droplets_ptq_mod
- 
-
-    PRIVATE
-    PUBLIC interaction_droplets_ptq
-
-    INTERFACE interaction_droplets_ptq
-!
-!--    Internal names shortened in order ro avoid Intel compiler messages
-!--    about too long names
-       MODULE PROCEDURE i_droplets_ptq
-       MODULE PROCEDURE i_droplets_ptq_ij
-    END INTERFACE interaction_droplets_ptq
- 
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE i_droplets_ptq
-
-       USE arrays_3d,                                                          &
-           ONLY:  pt_p, ql_c, q_p
-           
-       USE cloud_parameters,                                                   &
-           ONLY:  l_d_cp, pt_d_t
-           
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nyn, nys, nzb_s_inner, nzt
-           
-       USE kinds
-
-       USE pegrid
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
- 
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_s_inner(j,i)+1, nzt
-                q_p(k,j,i)  = q_p(k,j,i)  - ql_c(k,j,i)
-                pt_p(k,j,i) = pt_p(k,j,i) + l_d_cp * ql_c(k,j,i) * pt_d_t(k)
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE i_droplets_ptq
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE i_droplets_ptq_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  pt_p, ql_c, q_p
-
-       USE cloud_parameters,                                                   &
-           ONLY:  l_d_cp, pt_d_t
-
-       USE indices,                                                            &
-           ONLY:  nzb_s_inner, nzt
-
-       USE kinds,                                                              &
-           ONLY:  iwp, wp
-
-       USE pegrid
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
-
-       DO  k = nzb_s_inner(j,i)+1, nzt
-          q_p(k,j,i)  = q_p(k,j,i)  - ql_c(k,j,i)
-          pt_p(k,j,i) = pt_p(k,j,i) + l_d_cp * ql_c(k,j,i) * pt_d_t(k)
-       ENDDO
-
-    END SUBROUTINE i_droplets_ptq_ij
-
- END MODULE interaction_droplets_ptq_mod
Index: /palm/trunk/SOURCE/lpm_collision_kernels.f90
===================================================================
--- /palm/trunk/SOURCE/lpm_collision_kernels.f90	(revision 1873)
+++ /palm/trunk/SOURCE/lpm_collision_kernels.f90	(revision 1873)
@@ -0,0 +1,1001 @@
+!> @file lpm_collision_kernels.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+!
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1858 2016-04-13 13:12:11Z hoffmann
+! Interpolation of collision kernels adjusted to more reasonable values.
+! Reformatting of the code. 
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 1822 2016-04-07 07:49:42Z hoffmann
+! PALM kernel has been deleted.
+! Bugfix in the calculation of the turbulent enhancement factor of the
+! collection efficiency.
+!
+! Unused variables removed.
+!
+! 1776 2016-03-02 17:54:58Z hoffmann
+! Bugfix: Collection efficiencies must be calculated for the larger droplet.
+!
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable
+! 
+! 1519 2015-01-08 10:20:42Z hoffmann
+! Bugfix: Using the new particle structure, particles are not sorted by size.
+! Hence, computation of collision efficiencies must ensure that the ratio of 
+! two colliding droplets is < 1.
+!
+! 1359 2014-04-11 17:15:14Z hoffmann
+! New particle structure integrated.
+! Kind definition added to all floating point numbers.
+! 
+! 1346 2014-03-27 13:18:20Z heinze
+! Bugfix: REAL constants provided with KIND-attribute especially in call of 
+! intrinsic function like MAX, MIN, SIGN
+!
+! 1322 2014-03-20 16:38:49Z raasch
+! REAL constants defined as wp_kind
+!
+! 1320 2014-03-20 08:40:49Z 
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1092 2013-02-02 11:24:22Z raasch
+! unused variables removed
+!
+! 1071 2012-11-29 16:54:55Z franke
+! Bugfix: collision efficiencies for Hall kernel should not be < 1.0E-20
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1007 2012-09-19 14:30:36Z franke
+! converted all units to SI units and replaced some parameters by corresponding
+! PALM parameters
+! Bugfix: factor in calculation of enhancement factor for collision efficencies
+! changed from 10. to 1.0
+!
+! 849 2012-03-15 10:35:09Z raasch
+! routine collision_efficiency_rogers added (moved from former advec_particles
+! to here)
+!
+! 835 2012-02-22 11:21:19Z raasch $
+! Bugfix: array diss can be used only in case of Wang kernel
+!
+! 828 2012-02-21 12:00:36Z raasch
+! code has been completely reformatted, routine colker renamed
+! recalculate_kernel,
+! routine init_kernels added, radius is now communicated to the collision
+! routines by array radclass
+!
+! Bugfix: transformation factor for dissipation changed from 1E5 to 1E4
+!
+! 825 2012-02-19 03:03:44Z raasch
+! routine renamed from wang_kernel to lpm_collision_kernels,
+! turbulence_effects on collision replaced by wang_kernel
+!
+! 790 2011-11-29 03:11:20Z raasch
+! initial revision
+!
+! Description:
+! ------------
+!> This module calculates collision efficiencies either due to pure gravitational
+!> effects (Hall kernel, see Hall, 1980: J. Atmos. Sci., 2486-2507) or
+!> including the effects of turbulence (Wang kernel, see Wang and
+!> Grabowski, 2009: Atmos. Sci. Lett., 10, 1-8, and Ayala et al., 2008: 
+!> New J. Phys., 10, 075016). The original code has been
+!> provided by L.-P. Wang but is substantially reformatted and speed optimized
+!> here.
+!------------------------------------------------------------------------------!
+ MODULE lpm_collision_kernels_mod
+ 
+
+    USE constants,                                                             &
+        ONLY:  pi
+        
+    USE kinds
+
+    USE particle_attributes,                                                   &
+        ONLY:  collision_kernel, dissipation_classes, particles,               &
+               radius_classes
+
+    USE pegrid
+
+
+    IMPLICIT NONE
+
+    PRIVATE
+
+    PUBLIC  ckernel, init_kernels, rclass_lbound, rclass_ubound,               &
+            recalculate_kernel
+
+    REAL(wp) ::  epsilon       !<
+    REAL(wp) ::  rclass_lbound !<
+    REAL(wp) ::  rclass_ubound !<
+    REAL(wp) ::  urms          !<
+
+    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  epsclass  !< dissipation rate class
+    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  radclass  !< radius class
+    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  winf      !<
+    
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ec        !<
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ecf       !<
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  gck       !<
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  hkernel   !<
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  hwratio   !<
+    
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ckernel !<
+
+    SAVE
+
+!
+!-- Public interfaces
+    INTERFACE init_kernels
+       MODULE PROCEDURE init_kernels
+    END INTERFACE init_kernels
+
+    INTERFACE recalculate_kernel
+       MODULE PROCEDURE recalculate_kernel
+    END INTERFACE recalculate_kernel
+
+
+    CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Initialization of the collision efficiency matrix with fixed radius and
+!> dissipation classes, calculated at simulation start only.
+!------------------------------------------------------------------------------!
+ 
+    SUBROUTINE init_kernels
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+
+!
+!--    Calculate collision efficiencies for fixed radius- and dissipation
+!--    classes
+       IF ( collision_kernel(6:9) == 'fast' )  THEN
+
+          ALLOCATE( ckernel(1:radius_classes,1:radius_classes,                 &
+                    0:dissipation_classes), epsclass(1:dissipation_classes),   &
+                    radclass(1:radius_classes) )
+
+!
+!--       Calculate the radius class bounds with logarithmic distances
+!--       in the interval [1.0E-6, 1000.0E-6] m
+          rclass_lbound = LOG( 1.0E-6_wp )
+          rclass_ubound = LOG( 1000.0E-6_wp )
+          radclass(1)   = EXP( rclass_lbound )
+          DO  i = 2, radius_classes
+             radclass(i) = EXP( rclass_lbound +                                &
+                                ( rclass_ubound - rclass_lbound ) *            &
+                                ( i - 1.0_wp ) / ( radius_classes - 1.0_wp ) )
+          ENDDO
+
+!
+!--       Set the class bounds for dissipation in interval [0.0, 600.0] cm**2/s**3
+          DO  i = 1, dissipation_classes
+             epsclass(i) = 0.06_wp * REAL( i, KIND=wp ) / dissipation_classes
+          ENDDO
+!
+!--       Calculate collision efficiencies of the Wang/ayala kernel
+          ALLOCATE( ec(1:radius_classes,1:radius_classes),  &
+                    ecf(1:radius_classes,1:radius_classes), &
+                    gck(1:radius_classes,1:radius_classes), &
+                    winf(1:radius_classes) )
+
+          DO  k = 1, dissipation_classes
+
+             epsilon = epsclass(k)
+             urms    = 2.02_wp * ( epsilon / 0.04_wp )**( 1.0_wp / 3.0_wp )
+
+             CALL turbsd
+             CALL turb_enhance_eff
+             CALL effic
+
+             DO  j = 1, radius_classes
+                DO  i = 1, radius_classes
+                   ckernel(i,j,k) = ec(i,j) * gck(i,j) * ecf(i,j)
+                ENDDO
+             ENDDO
+
+          ENDDO
+
+!
+!--       Calculate collision efficiencies of the Hall kernel
+          ALLOCATE( hkernel(1:radius_classes,1:radius_classes), &
+                    hwratio(1:radius_classes,1:radius_classes) )
+
+          CALL fallg
+          CALL effic
+
+          DO  j = 1, radius_classes
+             DO  i =  1, radius_classes
+                hkernel(i,j) = pi * ( radclass(j) + radclass(i) )**2 &
+                                  * ec(i,j) * ABS( winf(j) - winf(i) )
+                ckernel(i,j,0) = hkernel(i,j)  ! hall kernel stored on index 0
+              ENDDO
+          ENDDO
+
+!
+!--       Test output of efficiencies
+          IF ( j == -1 )  THEN
+
+             PRINT*, '*** Hall kernel'
+             WRITE ( *,'(5X,20(F4.0,1X))' ) ( radclass(i)*1.0E6_wp, &
+                                              i = 1,radius_classes )
+             DO  j = 1, radius_classes
+                WRITE ( *,'(F4.0,1X,20(F8.4,1X))' ) radclass(j),  &
+                                          ( hkernel(i,j), i = 1,radius_classes )
+             ENDDO
+
+             DO  k = 1, dissipation_classes
+                DO  i = 1, radius_classes
+                   DO  j = 1, radius_classes
+                      IF ( hkernel(i,j) == 0.0_wp )  THEN
+                         hwratio(i,j) = 9999999.9_wp
+                      ELSE
+                         hwratio(i,j) = ckernel(i,j,k) / hkernel(i,j)
+                      ENDIF
+                   ENDDO
+                ENDDO
+
+                PRINT*, '*** epsilon = ', epsclass(k)
+                WRITE ( *,'(5X,20(F4.0,1X))' ) ( radclass(i) * 1.0E6_wp, &
+                                                 i = 1,radius_classes )
+                DO  j = 1, radius_classes
+                   WRITE ( *,'(F4.0,1X,20(F8.4,1X))' ) radclass(j) * 1.0E6_wp, &
+                                          ( hwratio(i,j), i = 1,radius_classes )
+                ENDDO
+             ENDDO
+
+          ENDIF
+
+          DEALLOCATE( ec, ecf, epsclass, gck, hkernel, winf )
+
+       ENDIF
+
+    END SUBROUTINE init_kernels
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Calculation of collision kernels during each timestep and for each grid box
+!------------------------------------------------------------------------------!
+    SUBROUTINE recalculate_kernel( i1, j1, k1 )
+
+       USE arrays_3d,                                                          &
+           ONLY:  diss
+
+       USE particle_attributes,                                                &
+           ONLY:  number_of_particles, prt_count, radius_classes, wang_kernel
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i      !<
+       INTEGER(iwp) ::  i1     !<
+       INTEGER(iwp) ::  j      !<
+       INTEGER(iwp) ::  j1     !<
+       INTEGER(iwp) ::  k1     !<
+
+
+       number_of_particles = prt_count(k1,j1,i1)
+       radius_classes      = number_of_particles   ! necessary to use the same
+                                                   ! subroutines as for 
+                                                   ! precalculated kernels
+
+       ALLOCATE( ec(1:number_of_particles,1:number_of_particles), &
+                 radclass(1:number_of_particles), winf(1:number_of_particles) )
+
+!
+!--    Store particle radii on the radclass array
+       radclass(1:number_of_particles) = particles(1:number_of_particles)%radius
+
+       IF ( wang_kernel )  THEN
+          epsilon = diss(k1,j1,i1)   ! dissipation rate in m**2/s**3
+       ELSE
+          epsilon = 0.0_wp
+       ENDIF
+       urms    = 2.02_wp * ( epsilon / 0.04_wp )**( 0.33333333333_wp )
+
+       IF ( wang_kernel  .AND.  epsilon > 1.0E-7_wp )  THEN
+!
+!--       Call routines to calculate efficiencies for the Wang kernel
+          ALLOCATE( gck(1:number_of_particles,1:number_of_particles), &
+                    ecf(1:number_of_particles,1:number_of_particles) )
+
+          CALL turbsd
+          CALL turb_enhance_eff
+          CALL effic
+
+          DO  j = 1, number_of_particles
+             DO  i =  1, number_of_particles
+                ckernel(1+i-1,1+j-1,1) = ec(i,j) * gck(i,j) * ecf(i,j)
+             ENDDO
+          ENDDO
+
+          DEALLOCATE( gck, ecf )
+
+       ELSE
+!
+!--       Call routines to calculate efficiencies for the Hall kernel
+          CALL fallg
+          CALL effic
+
+          DO  j = 1, number_of_particles
+             DO  i =  1, number_of_particles
+                ckernel(i,j,1) = pi * ( radclass(j) + radclass(i) )**2         &
+                                    * ec(i,j) * ABS( winf(j) - winf(i) )
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+       DEALLOCATE( ec, radclass, winf )
+
+    END SUBROUTINE recalculate_kernel
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Calculation of effects of turbulence on the geometric collision kernel 
+!> (by including the droplets' average radial relative velocities and their 
+!> radial distribution function) following the analytic model by Aayala et al. 
+!> (2008, New J. Phys.). For details check the second part 2 of the publication,
+!> page 37ff.
+!>
+!> Input parameters, which need to be replaced by PALM parameters:
+!>    water density, air density
+!------------------------------------------------------------------------------!
+    SUBROUTINE turbsd
+
+       USE control_parameters,                                                 &
+           ONLY:  g, molecular_viscosity
+    
+       USE particle_attributes,                                                &
+           ONLY:  radius_classes
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i     !<
+       INTEGER(iwp) ::  j     !<
+
+       REAL(wp) ::  ao        !<
+       REAL(wp) ::  ao_gr     !<
+       REAL(wp) ::  bbb       !<
+       REAL(wp) ::  be        !<
+       REAL(wp) ::  b1        !<
+       REAL(wp) ::  b2        !<
+       REAL(wp) ::  ccc       !<
+       REAL(wp) ::  c1        !<
+       REAL(wp) ::  c1_gr     !<
+       REAL(wp) ::  c2        !<
+       REAL(wp) ::  d1        !<
+       REAL(wp) ::  d2        !<
+       REAL(wp) ::  eta       !<
+       REAL(wp) ::  e1        !<
+       REAL(wp) ::  e2        !<
+       REAL(wp) ::  fao_gr    !<
+       REAL(wp) ::  fr        !<
+       REAL(wp) ::  grfin     !<
+       REAL(wp) ::  lambda    !<
+       REAL(wp) ::  lambda_re !<
+       REAL(wp) ::  lf        !<
+       REAL(wp) ::  rc        !<
+       REAL(wp) ::  rrp       !<
+       REAL(wp) ::  sst       !<
+       REAL(wp) ::  tauk      !<
+       REAL(wp) ::  tl        !<
+       REAL(wp) ::  t2        !<
+       REAL(wp) ::  tt        !<
+       REAL(wp) ::  t1        !<
+       REAL(wp) ::  vk        !<
+       REAL(wp) ::  vrms1xy   !<
+       REAL(wp) ::  vrms2xy   !<
+       REAL(wp) ::  v1        !<
+       REAL(wp) ::  v1v2xy    !<
+       REAL(wp) ::  v1xysq    !<
+       REAL(wp) ::  v2        !<
+       REAL(wp) ::  v2xysq    !<
+       REAL(wp) ::  wrfin     !<
+       REAL(wp) ::  wrgrav2   !<
+       REAL(wp) ::  wrtur2xy  !<
+       REAL(wp) ::  xx        !<
+       REAL(wp) ::  yy        !<
+       REAL(wp) ::  z         !<
+
+       REAL(wp), DIMENSION(1:radius_classes) ::  st  !< Stokes number
+       REAL(wp), DIMENSION(1:radius_classes) ::  tau !< inertial time scale
+
+       lambda    = urms * SQRT( 15.0_wp * molecular_viscosity / epsilon )
+       lambda_re = urms**2 * SQRT( 15.0_wp / epsilon / molecular_viscosity )
+       tl        = urms**2 / epsilon
+       lf        = 0.5_wp * urms**3 / epsilon
+       tauk      = SQRT( molecular_viscosity / epsilon )
+       eta       = ( molecular_viscosity**3 / epsilon )**0.25_wp
+       vk        = eta / tauk
+
+       ao = ( 11.0_wp + 7.0_wp * lambda_re ) / ( 205.0_wp + lambda_re )
+       tt = SQRT( 2.0_wp * lambda_re / ( SQRT( 15.0_wp ) * ao ) ) * tauk
+
+!
+!--    Get terminal velocity of droplets
+       CALL fallg
+
+       DO  i = 1, radius_classes
+          tau(i) = winf(i) / g    ! inertial time scale
+          st(i)  = tau(i) / tauk  ! Stokes number
+       ENDDO
+
+!
+!--    Calculate average radial relative velocity at contact (wrfin)
+       z   = tt / tl
+       be  = SQRT( 2.0_wp ) * lambda / lf
+       bbb = SQRT( 1.0_wp - 2.0_wp * be**2 )
+       d1  = ( 1.0_wp + bbb ) / ( 2.0_wp * bbb )
+       e1  = lf * ( 1.0_wp + bbb ) * 0.5_wp
+       d2  = ( 1.0_wp - bbb ) * 0.5_wp / bbb
+       e2  = lf * ( 1.0_wp - bbb ) * 0.5_wp
+       ccc = SQRT( 1.0_wp - 2.0_wp * z**2 )
+       b1  = ( 1.0_wp + ccc ) * 0.5_wp / ccc
+       c1  = tl * ( 1.0_wp + ccc ) * 0.5_wp
+       b2  = ( 1.0_wp - ccc ) * 0.5_wp / ccc
+       c2  = tl * ( 1.0_wp - ccc ) * 0.5_wp
+
+       DO  i = 1, radius_classes
+
+          v1 = winf(i)
+          t1 = tau(i)
+
+          DO  j = 1, i
+             rrp = radclass(i) + radclass(j)
+             v2  = winf(j)
+             t2  = tau(j)
+
+             v1xysq  = b1 * d1 * phi_w(c1,e1,v1,t1) - b1 * d2 * phi_w(c1,e2,v1,t1) &
+                     - b2 * d1 * phi_w(c2,e1,v1,t1) + b2 * d2 * phi_w(c2,e2,v1,t1)
+             v1xysq  = v1xysq * urms**2 / t1
+             vrms1xy = SQRT( v1xysq )
+
+             v2xysq  = b1 * d1 * phi_w(c1,e1,v2,t2) - b1 * d2 * phi_w(c1,e2,v2,t2) &
+                     - b2 * d1 * phi_w(c2,e1,v2,t2) + b2 * d2 * phi_w(c2,e2,v2,t2)
+             v2xysq  = v2xysq * urms**2 / t2
+             vrms2xy = SQRT( v2xysq )
+
+             IF ( winf(i) >= winf(j) )  THEN
+                v1 = winf(i)
+                t1 = tau(i)
+                v2 = winf(j)
+                t2 = tau(j)
+             ELSE
+                v1 = winf(j)
+                t1 = tau(j)
+                v2 = winf(i)
+                t2 = tau(i)
+             ENDIF
+
+             v1v2xy   =  b1 * d1 * zhi(c1,e1,v1,t1,v2,t2) - &
+                         b1 * d2 * zhi(c1,e2,v1,t1,v2,t2) - &
+                         b2 * d1 * zhi(c2,e1,v1,t1,v2,t2) + &
+                         b2 * d2* zhi(c2,e2,v1,t1,v2,t2)
+             fr       = d1 * EXP( -rrp / e1 ) - d2 * EXP( -rrp / e2 )
+             v1v2xy   = v1v2xy * fr * urms**2 / tau(i) / tau(j)
+             wrtur2xy = vrms1xy**2 + vrms2xy**2 - 2.0_wp * v1v2xy
+             IF ( wrtur2xy < 0.0_wp )  wrtur2xy = 0.0_wp
+             wrgrav2  = pi / 8.0_wp * ( winf(j) - winf(i) )**2
+             wrfin    = SQRT( ( 2.0_wp / pi ) * ( wrtur2xy + wrgrav2) )
+
+!
+!--          Calculate radial distribution function (grfin)
+             IF ( st(j) > st(i) )  THEN
+                sst = st(j)
+             ELSE
+                sst = st(i)
+             ENDIF
+
+             xx = -0.1988_wp * sst**4 + 1.5275_wp * sst**3 - 4.2942_wp *       &
+                   sst**2 + 5.3406_wp * sst
+             IF ( xx < 0.0_wp )  xx = 0.0_wp
+             yy = 0.1886_wp * EXP( 20.306_wp / lambda_re )
+
+             c1_gr  =  xx / ( g / vk * tauk )**yy
+
+             ao_gr  = ao + ( pi / 8.0_wp) * ( g / vk * tauk )**2
+             fao_gr = 20.115_wp * SQRT( ao_gr / lambda_re )
+             rc     = SQRT( fao_gr * ABS( st(j) - st(i) ) ) * eta
+
+             grfin  = ( ( eta**2 + rc**2 ) / ( rrp**2 + rc**2) )**( c1_gr*0.5_wp )
+             IF ( grfin < 1.0_wp )  grfin = 1.0_wp
+
+!
+!--          Calculate general collection kernel (without the consideration of
+!--          collection efficiencies)
+             gck(i,j) = 2.0_wp * pi * rrp**2 * wrfin * grfin
+             gck(j,i) = gck(i,j)
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE turbsd
+
+    REAL(wp) FUNCTION phi_w( a, b, vsett, tau0 )
+!
+!--    Function used in the Ayala et al. (2008) analytical model for turbulent
+!--    effects on the collision kernel
+       IMPLICIT NONE
+
+       REAL(wp) ::  a     !<
+       REAL(wp) ::  aa1   !<
+       REAL(wp) ::  b     !<
+       REAL(wp) ::  tau0  !<
+       REAL(wp) ::  vsett !<
+
+       aa1 = 1.0_wp / tau0 + 1.0_wp / a + vsett / b
+       phi_w = 1.0_wp / aa1  - 0.5_wp * vsett / b / aa1**2
+
+    END FUNCTION phi_w
+
+    REAL(wp) FUNCTION zhi( a, b, vsett1, tau1, vsett2, tau2 )
+!
+!--    Function used in the Ayala et al. (2008) analytical model for turbulent
+!--    effects on the collision kernel
+       IMPLICIT NONE
+
+       REAL(wp) ::  a      !<
+       REAL(wp) ::  aa1    !<
+       REAL(wp) ::  aa2    !<
+       REAL(wp) ::  aa3    !<
+       REAL(wp) ::  aa4    !<
+       REAL(wp) ::  aa5    !<
+       REAL(wp) ::  aa6    !<
+       REAL(wp) ::  b      !<
+       REAL(wp) ::  tau1   !<
+       REAL(wp) ::  tau2   !<
+       REAL(wp) ::  vsett1 !<
+       REAL(wp) ::  vsett2 !<
+
+       aa1 = vsett2 / b - 1.0_wp / tau2 - 1.0_wp / a
+       aa2 = vsett1 / b + 1.0_wp / tau1 + 1.0_wp / a
+       aa3 = ( vsett1 - vsett2 ) / b + 1.0_wp / tau1 + 1.0_wp / tau2
+       aa4 = ( vsett2 / b )**2 - ( 1.0_wp / tau2 + 1.0_wp / a )**2
+       aa5 = vsett2 / b + 1.0_wp / tau2 + 1.0_wp / a
+       aa6 = 1.0_wp / tau1 - 1.0_wp / a + ( 1.0_wp / tau2 + 1.0_wp / a) *      &
+             vsett1 / vsett2
+       zhi = (1.0_wp / aa1 - 1.0_wp / aa2 ) * ( vsett1 - vsett2 ) * 0.5_wp /   &
+             b / aa3**2 + ( 4.0_wp / aa4 - 1.0_wp / aa5**2 - 1.0_wp / aa1**2 ) &
+             * vsett2 * 0.5_wp / b /aa6 + ( 2.0_wp * ( b / aa2 - b / aa1 ) -   &
+             vsett1 / aa2**2 + vsett2 / aa1**2 ) * 0.5_wp / b / aa3
+
+    END FUNCTION zhi
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Parameterization of terminal velocity following Rogers et al. (1993, J. Appl.
+!> Meteorol.)
+!------------------------------------------------------------------------------!
+    SUBROUTINE fallg
+
+       USE particle_attributes,                                                &
+           ONLY:  radius_classes
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  j                            !<
+
+       REAL(wp), PARAMETER ::  k_cap_rog = 4.0_wp    !< parameter
+       REAL(wp), PARAMETER ::  k_low_rog = 12.0_wp   !< parameter
+       REAL(wp), PARAMETER ::  a_rog     = 9.65_wp   !< parameter
+       REAL(wp), PARAMETER ::  b_rog     = 10.43_wp  !< parameter
+       REAL(wp), PARAMETER ::  c_rog     = 0.6_wp    !< parameter
+       REAL(wp), PARAMETER ::  d0_rog    = 0.745_wp  !< seperation diameter
+
+       REAL(wp)            ::  diameter              !< droplet diameter in mm
+
+
+       DO  j = 1, radius_classes
+
+          diameter = radclass(j) * 2000.0_wp
+
+          IF ( diameter <= d0_rog )  THEN
+             winf(j) = k_cap_rog * diameter * ( 1.0_wp -                       &
+                                                EXP( -k_low_rog * diameter ) )
+          ELSE
+             winf(j) = a_rog - b_rog * EXP( -c_rog * diameter )
+          ENDIF
+
+       ENDDO
+
+    END SUBROUTINE fallg
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Interpolation of collision efficiencies (Hall, 1980, J. Atmos. Sci.)
+!------------------------------------------------------------------------------!
+    SUBROUTINE effic
+ 
+       USE particle_attributes,                                                &
+           ONLY:  radius_classes
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i  !<
+       INTEGER(iwp) ::  iq !<
+       INTEGER(iwp) ::  ir !<
+       INTEGER(iwp) ::  j  !<
+       INTEGER(iwp) ::  k  !<
+
+       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ira !<
+
+       LOGICAL, SAVE ::  first = .TRUE. !<
+
+       REAL(wp) ::  ek              !<
+       REAL(wp) ::  particle_radius !<
+       REAL(wp) ::  pp              !<
+       REAL(wp) ::  qq              !<
+       REAL(wp) ::  rq              !<
+
+       REAL(wp), DIMENSION(1:21), SAVE ::  rat        !<
+       
+       REAL(wp), DIMENSION(1:15), SAVE ::  r0         !<
+       
+       REAL(wp), DIMENSION(1:15,1:21), SAVE ::  ecoll !<
+
+!
+!--    Initial assignment of constants
+       IF ( first )  THEN
+
+         first = .FALSE.
+         r0  = (/   6.0_wp,   8.0_wp,  10.0_wp, 15.0_wp,  20.0_wp,  25.0_wp,   &
+                   30.0_wp,  40.0_wp,  50.0_wp, 60.0_wp,  70.0_wp, 100.0_wp,   &
+                  150.0_wp, 200.0_wp, 300.0_wp /)
+
+         rat = (/ 0.00_wp, 0.05_wp, 0.10_wp, 0.15_wp, 0.20_wp, 0.25_wp,        &
+                  0.30_wp, 0.35_wp, 0.40_wp, 0.45_wp, 0.50_wp, 0.55_wp,        &
+                  0.60_wp, 0.65_wp, 0.70_wp, 0.75_wp, 0.80_wp, 0.85_wp,        &
+                  0.90_wp, 0.95_wp, 1.00_wp /)
+
+         ecoll(:,1)  = (/ 0.001_wp, 0.001_wp, 0.001_wp, 0.001_wp, 0.001_wp,    &
+                          0.001_wp, 0.001_wp, 0.001_wp, 0.001_wp, 0.001_wp,    &
+                          0.001_wp, 0.001_wp, 0.001_wp, 0.001_wp, 0.001_wp /)
+         ecoll(:,2)  = (/ 0.003_wp, 0.003_wp, 0.003_wp, 0.004_wp, 0.005_wp,    &
+                          0.005_wp, 0.005_wp, 0.010_wp, 0.100_wp, 0.050_wp,    &
+                          0.200_wp, 0.500_wp, 0.770_wp, 0.870_wp, 0.970_wp /)
+         ecoll(:,3)  = (/ 0.007_wp, 0.007_wp, 0.007_wp, 0.008_wp, 0.009_wp,    &
+                          0.010_wp, 0.010_wp, 0.070_wp, 0.400_wp, 0.430_wp,    &
+                          0.580_wp, 0.790_wp, 0.930_wp, 0.960_wp, 1.000_wp /)
+         ecoll(:,4)  = (/ 0.009_wp, 0.009_wp, 0.009_wp, 0.012_wp, 0.015_wp,    &
+                          0.010_wp, 0.020_wp, 0.280_wp, 0.600_wp, 0.640_wp,    &
+                          0.750_wp, 0.910_wp, 0.970_wp, 0.980_wp, 1.000_wp /)
+         ecoll(:,5)  = (/ 0.014_wp, 0.014_wp, 0.014_wp, 0.015_wp, 0.016_wp,    &
+                          0.030_wp, 0.060_wp, 0.500_wp, 0.700_wp, 0.770_wp,    &
+                          0.840_wp, 0.950_wp, 0.970_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,6)  = (/ 0.017_wp, 0.017_wp, 0.017_wp, 0.020_wp, 0.022_wp,    &
+                          0.060_wp, 0.100_wp, 0.620_wp, 0.780_wp, 0.840_wp,    &
+                          0.880_wp, 0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,7)  = (/ 0.030_wp, 0.030_wp, 0.024_wp, 0.022_wp, 0.032_wp,    &
+                          0.062_wp, 0.200_wp, 0.680_wp, 0.830_wp, 0.870_wp,    &
+                          0.900_wp, 0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,8)  = (/ 0.025_wp, 0.025_wp, 0.025_wp, 0.036_wp, 0.043_wp,    &
+                          0.130_wp, 0.270_wp, 0.740_wp, 0.860_wp, 0.890_wp,    &
+                          0.920_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,9)  = (/ 0.027_wp, 0.027_wp, 0.027_wp, 0.040_wp, 0.052_wp,    &
+                          0.200_wp, 0.400_wp, 0.780_wp, 0.880_wp, 0.900_wp,    &
+                          0.940_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,10) = (/ 0.030_wp, 0.030_wp, 0.030_wp, 0.047_wp, 0.064_wp,    &
+                          0.250_wp, 0.500_wp, 0.800_wp, 0.900_wp, 0.910_wp,    &
+                          0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,11) = (/ 0.040_wp, 0.040_wp, 0.033_wp, 0.037_wp, 0.068_wp,    &
+                          0.240_wp, 0.550_wp, 0.800_wp, 0.900_wp, 0.910_wp,    &
+                          0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,12) = (/ 0.035_wp, 0.035_wp, 0.035_wp, 0.055_wp, 0.079_wp,    &
+                          0.290_wp, 0.580_wp, 0.800_wp, 0.900_wp, 0.910_wp,    &
+                          0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,13) = (/ 0.037_wp, 0.037_wp, 0.037_wp, 0.062_wp, 0.082_wp,    &
+                          0.290_wp, 0.590_wp, 0.780_wp, 0.900_wp, 0.910_wp,    &
+                          0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,14) = (/ 0.037_wp, 0.037_wp, 0.037_wp, 0.060_wp, 0.080_wp,    &
+                          0.290_wp, 0.580_wp, 0.770_wp, 0.890_wp, 0.910_wp,    &
+                          0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,15) = (/ 0.037_wp, 0.037_wp, 0.037_wp, 0.041_wp, 0.075_wp,    &
+                          0.250_wp, 0.540_wp, 0.760_wp, 0.880_wp, 0.920_wp,    &
+                          0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,16) = (/ 0.037_wp, 0.037_wp, 0.037_wp, 0.052_wp, 0.067_wp,    &
+                          0.250_wp, 0.510_wp, 0.770_wp, 0.880_wp, 0.930_wp,    &
+                          0.970_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,17) = (/ 0.037_wp, 0.037_wp, 0.037_wp, 0.047_wp, 0.057_wp,    &
+                          0.250_wp, 0.490_wp, 0.770_wp, 0.890_wp, 0.950_wp,    &
+                          1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
+         ecoll(:,18) = (/ 0.036_wp, 0.036_wp, 0.036_wp, 0.042_wp, 0.048_wp,    &
+                          0.230_wp, 0.470_wp, 0.780_wp, 0.920_wp, 1.000_wp,    &
+                          1.020_wp, 1.020_wp, 1.020_wp, 1.020_wp, 1.020_wp /)
+         ecoll(:,19) = (/ 0.040_wp, 0.040_wp, 0.035_wp, 0.033_wp, 0.040_wp,    &
+                          0.112_wp, 0.450_wp, 0.790_wp, 1.010_wp, 1.030_wp,    &
+                          1.040_wp, 1.040_wp, 1.040_wp, 1.040_wp, 1.040_wp /)
+         ecoll(:,20) = (/ 0.033_wp, 0.033_wp, 0.033_wp, 0.033_wp, 0.033_wp,    &
+                          0.119_wp, 0.470_wp, 0.950_wp, 1.300_wp, 1.700_wp,    &
+                          2.300_wp, 2.300_wp, 2.300_wp, 2.300_wp, 2.300_wp /)
+         ecoll(:,21) = (/ 0.027_wp, 0.027_wp, 0.027_wp, 0.027_wp, 0.027_wp,    &
+                          0.125_wp, 0.520_wp, 1.400_wp, 2.300_wp, 3.000_wp,    &
+                          4.000_wp, 4.000_wp, 4.000_wp, 4.000_wp, 4.000_wp /)
+       ENDIF
+
+!
+!--    Calculate the radius class index of particles with respect to array r
+!--    Radius has to be in microns
+       ALLOCATE( ira(1:radius_classes) )
+       DO  j = 1, radius_classes
+          particle_radius = radclass(j) * 1.0E6_wp
+          DO  k = 1, 15
+             IF ( particle_radius < r0(k) )  THEN
+                ira(j) = k
+                EXIT
+             ENDIF
+          ENDDO
+          IF ( particle_radius >= r0(15) )  ira(j) = 16
+       ENDDO
+
+!
+!--    Two-dimensional linear interpolation of the collision efficiency.
+!--    Radius has to be in microns
+       DO  j = 1, radius_classes
+          DO  i = 1, j
+
+             ir = ira(j)
+             rq = MIN( radclass(i) / radclass(j), radclass(j) / radclass(i) )
+             iq = INT( rq * 20 ) + 1
+             iq = MAX( iq , 2)
+
+             IF ( ir < 16 )  THEN
+                IF ( ir >= 2 )  THEN
+                   pp = ( ( MAX( radclass(j), radclass(i) ) * 1.0E6_wp ) -     &
+                          r0(ir-1) ) / ( r0(ir) - r0(ir-1) )
+                   qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) )
+                   ec(j,i) = ( 1.0_wp - pp ) * ( 1.0_wp - qq )                 &
+                             * ecoll(ir-1,iq-1)                                &
+                             + pp * ( 1.0_wp - qq ) * ecoll(ir,iq-1)           &
+                             + qq * ( 1.0_wp - pp ) * ecoll(ir-1,iq)           &
+                             + pp * qq * ecoll(ir,iq)
+                ELSE
+                   qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) )
+                   ec(j,i) = ( 1.0_wp - qq ) * ecoll(1,iq-1) + qq * ecoll(1,iq)
+                ENDIF
+             ELSE
+                qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) )
+                ek = ( 1.0_wp - qq ) * ecoll(15,iq-1) + qq * ecoll(15,iq)
+                ec(j,i) = MIN( ek, 1.0_wp )
+             ENDIF
+
+             IF ( ec(j,i) < 1.0E-20_wp )  ec(j,i) = 0.0_wp
+
+             ec(i,j) = ec(j,i)
+
+          ENDDO
+       ENDDO
+
+       DEALLOCATE( ira )
+
+    END SUBROUTINE effic
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Interpolation of turbulent enhancement factor for collision efficencies
+!> following Wang and Grabowski (2009, Atmos. Sci. Let.)
+!------------------------------------------------------------------------------!
+    SUBROUTINE turb_enhance_eff
+
+       USE particle_attributes,                                                &
+           ONLY:  radius_classes
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) :: i  !<
+       INTEGER(iwp) :: iq !<
+       INTEGER(iwp) :: ir !<
+       INTEGER(iwp) :: j  !<
+       INTEGER(iwp) :: k  !<
+       INTEGER(iwp) :: kk !<
+
+       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ira !<
+       
+       LOGICAL, SAVE ::  first = .TRUE. !<
+
+       REAL(wp) ::  particle_radius !<
+       REAL(wp) ::  pp              !<
+       REAL(wp) ::  qq              !<
+       REAL(wp) ::  rq              !<
+       REAL(wp) ::  y1              !<
+       REAL(wp) ::  y2              !<
+       REAL(wp) ::  y3              !<
+
+       REAL(wp), DIMENSION(1:11), SAVE ::  rat           !<
+       REAL(wp), DIMENSION(1:7), SAVE  ::  r0            !<
+       
+       REAL(wp), DIMENSION(1:7,1:11), SAVE ::  ecoll_100 !<
+       REAL(wp), DIMENSION(1:7,1:11), SAVE ::  ecoll_400 !<
+
+!
+!--    Initial assignment of constants
+       IF ( first )  THEN
+
+          first = .FALSE.
+
+          r0  = (/  10.0_wp, 20.0_wp, 30.0_wp, 40.0_wp, 50.0_wp, 60.0_wp,  &
+                   100.0_wp /)
+
+          rat = (/ 0.0_wp, 0.1_wp, 0.2_wp, 0.3_wp, 0.4_wp, 0.5_wp, 0.6_wp, &
+                   0.7_wp, 0.8_wp, 0.9_wp, 1.0_wp /)
+!
+!--       Tabulated turbulent enhancement factor at 100 cm**2/s**3
+          ecoll_100(:,1)  = (/  1.74_wp,   1.74_wp,   1.773_wp, 1.49_wp,  &
+                                1.207_wp,  1.207_wp,  1.0_wp /)
+          ecoll_100(:,2)  = (/  1.46_wp,   1.46_wp,   1.421_wp, 1.245_wp, &
+                                1.069_wp,  1.069_wp,  1.0_wp /)
+          ecoll_100(:,3)  = (/  1.32_wp,   1.32_wp,   1.245_wp, 1.123_wp, &
+                                1.000_wp,  1.000_wp,  1.0_wp /)
+          ecoll_100(:,4)  = (/  1.250_wp,  1.250_wp,  1.148_wp, 1.087_wp, &
+                                1.025_wp,  1.025_wp,  1.0_wp /)
+          ecoll_100(:,5)  = (/  1.186_wp,  1.186_wp,  1.066_wp, 1.060_wp, &
+                                1.056_wp,  1.056_wp,  1.0_wp /)
+          ecoll_100(:,6)  = (/  1.045_wp,  1.045_wp,  1.000_wp, 1.014_wp, &
+                                1.028_wp,  1.028_wp,  1.0_wp /)
+          ecoll_100(:,7)  = (/  1.070_wp,  1.070_wp,  1.030_wp, 1.038_wp, &
+                                1.046_wp,  1.046_wp,  1.0_wp /)
+          ecoll_100(:,8)  = (/  1.000_wp,  1.000_wp,  1.054_wp, 1.042_wp, &
+                                1.029_wp,  1.029_wp,  1.0_wp /)
+          ecoll_100(:,9)  = (/  1.223_wp,  1.223_wp,  1.117_wp, 1.069_wp, &
+                                1.021_wp,  1.021_wp,  1.0_wp /)
+          ecoll_100(:,10) = (/  1.570_wp,  1.570_wp,  1.244_wp, 1.166_wp, &
+                                1.088_wp,  1.088_wp,  1.0_wp /)
+          ecoll_100(:,11) = (/ 20.3_wp,   20.3_wp,   14.6_wp,   8.61_wp,  &
+                                2.60_wp,   2.60_wp,   1.0_wp /)
+!
+!--       Tabulated turbulent enhancement factor at 400 cm**2/s**3
+          ecoll_400(:,1)  = (/  4.976_wp,  4.976_wp,  3.593_wp,  2.519_wp, &
+                                1.445_wp,  1.445_wp,  1.0_wp /)
+          ecoll_400(:,2)  = (/  2.984_wp,  2.984_wp,  2.181_wp,  1.691_wp, &
+                                1.201_wp,  1.201_wp,  1.0_wp /)
+          ecoll_400(:,3)  = (/  1.988_wp,  1.988_wp,  1.475_wp,  1.313_wp, &
+                                1.150_wp,  1.150_wp,  1.0_wp /)
+          ecoll_400(:,4)  = (/  1.490_wp,  1.490_wp,  1.187_wp,  1.156_wp, &
+                                1.126_wp,  1.126_wp,  1.0_wp /)
+          ecoll_400(:,5)  = (/  1.249_wp,  1.249_wp,  1.088_wp,  1.090_wp, &
+                                1.092_wp,  1.092_wp,  1.0_wp /)
+          ecoll_400(:,6)  = (/  1.139_wp,  1.139_wp,  1.130_wp,  1.091_wp, &
+                                1.051_wp,  1.051_wp,  1.0_wp /)
+          ecoll_400(:,7)  = (/  1.220_wp,  1.220_wp,  1.190_wp,  1.138_wp, &
+                                1.086_wp,  1.086_wp,  1.0_wp /)
+          ecoll_400(:,8)  = (/  1.325_wp,  1.325_wp,  1.267_wp,  1.165_wp, &
+                                1.063_wp,  1.063_wp,  1.0_wp /)
+          ecoll_400(:,9)  = (/  1.716_wp,  1.716_wp,  1.345_wp,  1.223_wp, &
+                                1.100_wp,  1.100_wp,  1.0_wp /)
+          ecoll_400(:,10) = (/  3.788_wp,  3.788_wp,  1.501_wp,  1.311_wp, &
+                                1.120_wp,  1.120_wp,  1.0_wp /)
+          ecoll_400(:,11) = (/ 36.52_wp,  36.52_wp,  19.16_wp,  22.80_wp,  &
+                               26.0_wp,   26.0_wp,    1.0_wp /)
+
+       ENDIF
+
+!
+!--    Calculate the radius class index of particles with respect to array r0
+!--    The droplet radius has to be given in microns.
+       ALLOCATE( ira(1:radius_classes) )
+
+       DO  j = 1, radius_classes
+          particle_radius = radclass(j) * 1.0E6_wp
+          DO  k = 1, 7
+             IF ( particle_radius < r0(k) )  THEN
+                ira(j) = k
+                EXIT
+             ENDIF
+          ENDDO
+          IF ( particle_radius >= r0(7) )  ira(j) = 8
+       ENDDO
+
+!
+!--    Two-dimensional linear interpolation of the turbulent enhancement factor.
+!--    The droplet radius has to be given in microns.
+       DO  j =  1, radius_classes
+          DO  i = 1, j
+
+             ir = ira(j)
+             rq = MIN( radclass(i) / radclass(j), radclass(j) / radclass(i) )
+
+             DO  kk = 2, 11
+                IF ( rq <= rat(kk) )  THEN
+                   iq = kk
+                   EXIT
+                ENDIF
+             ENDDO
+
+             y1 = 1.0_wp  ! turbulent enhancement factor at 0 m**2/s**3
+
+             IF ( ir < 8 )  THEN
+                IF ( ir >= 2 )  THEN
+                   pp = ( MAX( radclass(j), radclass(i) ) * 1.0E6_wp -  &
+                          r0(ir-1) ) / ( r0(ir) - r0(ir-1) )
+                   qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) )
+                   y2 = ( 1.0_wp - pp ) * ( 1.0_wp - qq ) * ecoll_100(ir-1,iq-1) + &
+                                pp * ( 1.0_wp - qq ) * ecoll_100(ir,iq-1)        + &
+                                qq * ( 1.0_wp - pp ) * ecoll_100(ir-1,iq)        + &
+                                pp * qq              * ecoll_100(ir,iq)
+                   y3 = ( 1.0-pp ) * ( 1.0_wp - qq ) * ecoll_400(ir-1,iq-1)      + &
+                                pp * ( 1.0_wp - qq ) * ecoll_400(ir,iq-1)        + &
+                                qq * ( 1.0_wp - pp ) * ecoll_400(ir-1,iq)        + &
+                                pp * qq              * ecoll_400(ir,iq)
+                ELSE
+                   qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) )
+                   y2 = ( 1.0_wp - qq ) * ecoll_100(1,iq-1) + qq * ecoll_100(1,iq)
+                   y3 = ( 1.0_wp - qq ) * ecoll_400(1,iq-1) + qq * ecoll_400(1,iq)
+                ENDIF
+             ELSE
+                qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) )
+                y2 = ( 1.0_wp - qq ) * ecoll_100(7,iq-1) + qq * ecoll_100(7,iq)
+                y3 = ( 1.0_wp - qq ) * ecoll_400(7,iq-1) + qq * ecoll_400(7,iq)
+             ENDIF
+!
+!--          Linear interpolation of turbulent enhancement factor
+             IF ( epsilon <= 0.01_wp )  THEN
+                ecf(j,i) = ( epsilon - 0.01_wp ) / ( 0.0_wp  - 0.01_wp ) * y1 &
+                         + ( epsilon - 0.0_wp  ) / ( 0.01_wp - 0.0_wp  ) * y2
+             ELSEIF ( epsilon <= 0.06_wp )  THEN
+                ecf(j,i) = ( epsilon - 0.04_wp ) / ( 0.01_wp - 0.04_wp ) * y2 &
+                         + ( epsilon - 0.01_wp ) / ( 0.04_wp - 0.01_wp ) * y3
+             ELSE
+                ecf(j,i) = ( 0.06_wp - 0.04_wp ) / ( 0.01_wp - 0.04_wp ) * y2 &
+                         + ( 0.06_wp - 0.01_wp ) / ( 0.04_wp - 0.01_wp ) * y3
+             ENDIF
+
+             IF ( ecf(j,i) < 1.0_wp )  ecf(j,i) = 1.0_wp
+
+             ecf(i,j) = ecf(j,i)
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE turb_enhance_eff
+
+ END MODULE lpm_collision_kernels_mod
Index: lm/trunk/SOURCE/lpm_collision_kernels_mod.f90
===================================================================
--- /palm/trunk/SOURCE/lpm_collision_kernels_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,1000 +1,0 @@
-!> @file lpm_collision_kernels_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-!
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1858 2016-04-13 13:12:11Z hoffmann
-! Interpolation of collision kernels adjusted to more reasonable values.
-! Reformatting of the code. 
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 1822 2016-04-07 07:49:42Z hoffmann
-! PALM kernel has been deleted.
-! Bugfix in the calculation of the turbulent enhancement factor of the
-! collection efficiency.
-!
-! Unused variables removed.
-!
-! 1776 2016-03-02 17:54:58Z hoffmann
-! Bugfix: Collection efficiencies must be calculated for the larger droplet.
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable
-! 
-! 1519 2015-01-08 10:20:42Z hoffmann
-! Bugfix: Using the new particle structure, particles are not sorted by size.
-! Hence, computation of collision efficiencies must ensure that the ratio of 
-! two colliding droplets is < 1.
-!
-! 1359 2014-04-11 17:15:14Z hoffmann
-! New particle structure integrated.
-! Kind definition added to all floating point numbers.
-! 
-! 1346 2014-03-27 13:18:20Z heinze
-! Bugfix: REAL constants provided with KIND-attribute especially in call of 
-! intrinsic function like MAX, MIN, SIGN
-!
-! 1322 2014-03-20 16:38:49Z raasch
-! REAL constants defined as wp_kind
-!
-! 1320 2014-03-20 08:40:49Z 
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1092 2013-02-02 11:24:22Z raasch
-! unused variables removed
-!
-! 1071 2012-11-29 16:54:55Z franke
-! Bugfix: collision efficiencies for Hall kernel should not be < 1.0E-20
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1007 2012-09-19 14:30:36Z franke
-! converted all units to SI units and replaced some parameters by corresponding
-! PALM parameters
-! Bugfix: factor in calculation of enhancement factor for collision efficencies
-! changed from 10. to 1.0
-!
-! 849 2012-03-15 10:35:09Z raasch
-! routine collision_efficiency_rogers added (moved from former advec_particles
-! to here)
-!
-! 835 2012-02-22 11:21:19Z raasch $
-! Bugfix: array diss can be used only in case of Wang kernel
-!
-! 828 2012-02-21 12:00:36Z raasch
-! code has been completely reformatted, routine colker renamed
-! recalculate_kernel,
-! routine init_kernels added, radius is now communicated to the collision
-! routines by array radclass
-!
-! Bugfix: transformation factor for dissipation changed from 1E5 to 1E4
-!
-! 825 2012-02-19 03:03:44Z raasch
-! routine renamed from wang_kernel to lpm_collision_kernels,
-! turbulence_effects on collision replaced by wang_kernel
-!
-! 790 2011-11-29 03:11:20Z raasch
-! initial revision
-!
-! Description:
-! ------------
-!> This module calculates collision efficiencies either due to pure gravitational
-!> effects (Hall kernel, see Hall, 1980: J. Atmos. Sci., 2486-2507) or
-!> including the effects of turbulence (Wang kernel, see Wang and
-!> Grabowski, 2009: Atmos. Sci. Lett., 10, 1-8, and Ayala et al., 2008: 
-!> New J. Phys., 10, 075016). The original code has been
-!> provided by L.-P. Wang but is substantially reformatted and speed optimized
-!> here.
-!------------------------------------------------------------------------------!
- MODULE lpm_collision_kernels_mod
- 
-
-    USE constants,                                                             &
-        ONLY:  pi
-        
-    USE kinds
-
-    USE particle_attributes,                                                   &
-        ONLY:  collision_kernel, dissipation_classes, particles,               &
-               radius_classes
-
-    USE pegrid
-
-
-    IMPLICIT NONE
-
-    PRIVATE
-
-    PUBLIC  ckernel, init_kernels, rclass_lbound, rclass_ubound,               &
-            recalculate_kernel
-
-    REAL(wp) ::  epsilon       !<
-    REAL(wp) ::  rclass_lbound !<
-    REAL(wp) ::  rclass_ubound !<
-    REAL(wp) ::  urms          !<
-
-    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  epsclass  !< dissipation rate class
-    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  radclass  !< radius class
-    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  winf      !<
-    
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ec        !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ecf       !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  gck       !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  hkernel   !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  hwratio   !<
-    
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ckernel !<
-
-    SAVE
-
-!
-!-- Public interfaces
-    INTERFACE init_kernels
-       MODULE PROCEDURE init_kernels
-    END INTERFACE init_kernels
-
-    INTERFACE recalculate_kernel
-       MODULE PROCEDURE recalculate_kernel
-    END INTERFACE recalculate_kernel
-
-
-    CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the collision efficiency matrix with fixed radius and
-!> dissipation classes, calculated at simulation start only.
-!------------------------------------------------------------------------------!
- 
-    SUBROUTINE init_kernels
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i !<
-       INTEGER(iwp) ::  j !<
-       INTEGER(iwp) ::  k !<
-
-
-!
-!--    Calculate collision efficiencies for fixed radius- and dissipation
-!--    classes
-       IF ( collision_kernel(6:9) == 'fast' )  THEN
-
-          ALLOCATE( ckernel(1:radius_classes,1:radius_classes,                 &
-                    0:dissipation_classes), epsclass(1:dissipation_classes),   &
-                    radclass(1:radius_classes) )
-
-!
-!--       Calculate the radius class bounds with logarithmic distances
-!--       in the interval [1.0E-6, 1000.0E-6] m
-          rclass_lbound = LOG( 1.0E-6_wp )
-          rclass_ubound = LOG( 1000.0E-6_wp )
-          radclass(1)   = EXP( rclass_lbound )
-          DO  i = 2, radius_classes
-             radclass(i) = EXP( rclass_lbound +                                &
-                                ( rclass_ubound - rclass_lbound ) *            &
-                                ( i - 1.0_wp ) / ( radius_classes - 1.0_wp ) )
-          ENDDO
-
-!
-!--       Set the class bounds for dissipation in interval [0.0, 600.0] cm**2/s**3
-          DO  i = 1, dissipation_classes
-             epsclass(i) = 0.06_wp * REAL( i, KIND=wp ) / dissipation_classes
-          ENDDO
-!
-!--       Calculate collision efficiencies of the Wang/ayala kernel
-          ALLOCATE( ec(1:radius_classes,1:radius_classes),  &
-                    ecf(1:radius_classes,1:radius_classes), &
-                    gck(1:radius_classes,1:radius_classes), &
-                    winf(1:radius_classes) )
-
-          DO  k = 1, dissipation_classes
-
-             epsilon = epsclass(k)
-             urms    = 2.02_wp * ( epsilon / 0.04_wp )**( 1.0_wp / 3.0_wp )
-
-             CALL turbsd
-             CALL turb_enhance_eff
-             CALL effic
-
-             DO  j = 1, radius_classes
-                DO  i = 1, radius_classes
-                   ckernel(i,j,k) = ec(i,j) * gck(i,j) * ecf(i,j)
-                ENDDO
-             ENDDO
-
-          ENDDO
-
-!
-!--       Calculate collision efficiencies of the Hall kernel
-          ALLOCATE( hkernel(1:radius_classes,1:radius_classes), &
-                    hwratio(1:radius_classes,1:radius_classes) )
-
-          CALL fallg
-          CALL effic
-
-          DO  j = 1, radius_classes
-             DO  i =  1, radius_classes
-                hkernel(i,j) = pi * ( radclass(j) + radclass(i) )**2 &
-                                  * ec(i,j) * ABS( winf(j) - winf(i) )
-                ckernel(i,j,0) = hkernel(i,j)  ! hall kernel stored on index 0
-              ENDDO
-          ENDDO
-
-!
-!--       Test output of efficiencies
-          IF ( j == -1 )  THEN
-
-             PRINT*, '*** Hall kernel'
-             WRITE ( *,'(5X,20(F4.0,1X))' ) ( radclass(i)*1.0E6_wp, &
-                                              i = 1,radius_classes )
-             DO  j = 1, radius_classes
-                WRITE ( *,'(F4.0,1X,20(F8.4,1X))' ) radclass(j),  &
-                                          ( hkernel(i,j), i = 1,radius_classes )
-             ENDDO
-
-             DO  k = 1, dissipation_classes
-                DO  i = 1, radius_classes
-                   DO  j = 1, radius_classes
-                      IF ( hkernel(i,j) == 0.0_wp )  THEN
-                         hwratio(i,j) = 9999999.9_wp
-                      ELSE
-                         hwratio(i,j) = ckernel(i,j,k) / hkernel(i,j)
-                      ENDIF
-                   ENDDO
-                ENDDO
-
-                PRINT*, '*** epsilon = ', epsclass(k)
-                WRITE ( *,'(5X,20(F4.0,1X))' ) ( radclass(i) * 1.0E6_wp, &
-                                                 i = 1,radius_classes )
-                DO  j = 1, radius_classes
-                   WRITE ( *,'(F4.0,1X,20(F8.4,1X))' ) radclass(j) * 1.0E6_wp, &
-                                          ( hwratio(i,j), i = 1,radius_classes )
-                ENDDO
-             ENDDO
-
-          ENDIF
-
-          DEALLOCATE( ec, ecf, epsclass, gck, hkernel, winf )
-
-       ENDIF
-
-    END SUBROUTINE init_kernels
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of collision kernels during each timestep and for each grid box
-!------------------------------------------------------------------------------!
-    SUBROUTINE recalculate_kernel( i1, j1, k1 )
-
-       USE arrays_3d,                                                          &
-           ONLY:  diss
-
-       USE particle_attributes,                                                &
-           ONLY:  number_of_particles, prt_count, radius_classes, wang_kernel
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i      !<
-       INTEGER(iwp) ::  i1     !<
-       INTEGER(iwp) ::  j      !<
-       INTEGER(iwp) ::  j1     !<
-       INTEGER(iwp) ::  k1     !<
-
-
-       number_of_particles = prt_count(k1,j1,i1)
-       radius_classes      = number_of_particles   ! necessary to use the same
-                                                   ! subroutines as for 
-                                                   ! precalculated kernels
-
-       ALLOCATE( ec(1:number_of_particles,1:number_of_particles), &
-                 radclass(1:number_of_particles), winf(1:number_of_particles) )
-
-!
-!--    Store particle radii on the radclass array
-       radclass(1:number_of_particles) = particles(1:number_of_particles)%radius
-
-       IF ( wang_kernel )  THEN
-          epsilon = diss(k1,j1,i1)   ! dissipation rate in m**2/s**3
-       ELSE
-          epsilon = 0.0_wp
-       ENDIF
-       urms    = 2.02_wp * ( epsilon / 0.04_wp )**( 0.33333333333_wp )
-
-       IF ( wang_kernel  .AND.  epsilon > 1.0E-7_wp )  THEN
-!
-!--       Call routines to calculate efficiencies for the Wang kernel
-          ALLOCATE( gck(1:number_of_particles,1:number_of_particles), &
-                    ecf(1:number_of_particles,1:number_of_particles) )
-
-          CALL turbsd
-          CALL turb_enhance_eff
-          CALL effic
-
-          DO  j = 1, number_of_particles
-             DO  i =  1, number_of_particles
-                ckernel(1+i-1,1+j-1,1) = ec(i,j) * gck(i,j) * ecf(i,j)
-             ENDDO
-          ENDDO
-
-          DEALLOCATE( gck, ecf )
-
-       ELSE
-!
-!--       Call routines to calculate efficiencies for the Hall kernel
-          CALL fallg
-          CALL effic
-
-          DO  j = 1, number_of_particles
-             DO  i =  1, number_of_particles
-                ckernel(i,j,1) = pi * ( radclass(j) + radclass(i) )**2         &
-                                    * ec(i,j) * ABS( winf(j) - winf(i) )
-             ENDDO
-          ENDDO
-
-       ENDIF
-
-       DEALLOCATE( ec, radclass, winf )
-
-    END SUBROUTINE recalculate_kernel
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculation of effects of turbulence on the geometric collision kernel 
-!> (by including the droplets' average radial relative velocities and their 
-!> radial distribution function) following the analytic model by Aayala et al. 
-!> (2008, New J. Phys.). For details check the second part 2 of the publication,
-!> page 37ff.
-!>
-!> Input parameters, which need to be replaced by PALM parameters:
-!>    water density, air density
-!------------------------------------------------------------------------------!
-    SUBROUTINE turbsd
-
-       USE control_parameters,                                                 &
-           ONLY:  g, molecular_viscosity
-    
-       USE particle_attributes,                                                &
-           ONLY:  radius_classes
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i     !<
-       INTEGER(iwp) ::  j     !<
-
-       REAL(wp) ::  ao        !<
-       REAL(wp) ::  ao_gr     !<
-       REAL(wp) ::  bbb       !<
-       REAL(wp) ::  be        !<
-       REAL(wp) ::  b1        !<
-       REAL(wp) ::  b2        !<
-       REAL(wp) ::  ccc       !<
-       REAL(wp) ::  c1        !<
-       REAL(wp) ::  c1_gr     !<
-       REAL(wp) ::  c2        !<
-       REAL(wp) ::  d1        !<
-       REAL(wp) ::  d2        !<
-       REAL(wp) ::  eta       !<
-       REAL(wp) ::  e1        !<
-       REAL(wp) ::  e2        !<
-       REAL(wp) ::  fao_gr    !<
-       REAL(wp) ::  fr        !<
-       REAL(wp) ::  grfin     !<
-       REAL(wp) ::  lambda    !<
-       REAL(wp) ::  lambda_re !<
-       REAL(wp) ::  lf        !<
-       REAL(wp) ::  rc        !<
-       REAL(wp) ::  rrp       !<
-       REAL(wp) ::  sst       !<
-       REAL(wp) ::  tauk      !<
-       REAL(wp) ::  tl        !<
-       REAL(wp) ::  t2        !<
-       REAL(wp) ::  tt        !<
-       REAL(wp) ::  t1        !<
-       REAL(wp) ::  vk        !<
-       REAL(wp) ::  vrms1xy   !<
-       REAL(wp) ::  vrms2xy   !<
-       REAL(wp) ::  v1        !<
-       REAL(wp) ::  v1v2xy    !<
-       REAL(wp) ::  v1xysq    !<
-       REAL(wp) ::  v2        !<
-       REAL(wp) ::  v2xysq    !<
-       REAL(wp) ::  wrfin     !<
-       REAL(wp) ::  wrgrav2   !<
-       REAL(wp) ::  wrtur2xy  !<
-       REAL(wp) ::  xx        !<
-       REAL(wp) ::  yy        !<
-       REAL(wp) ::  z         !<
-
-       REAL(wp), DIMENSION(1:radius_classes) ::  st  !< Stokes number
-       REAL(wp), DIMENSION(1:radius_classes) ::  tau !< inertial time scale
-
-       lambda    = urms * SQRT( 15.0_wp * molecular_viscosity / epsilon )
-       lambda_re = urms**2 * SQRT( 15.0_wp / epsilon / molecular_viscosity )
-       tl        = urms**2 / epsilon
-       lf        = 0.5_wp * urms**3 / epsilon
-       tauk      = SQRT( molecular_viscosity / epsilon )
-       eta       = ( molecular_viscosity**3 / epsilon )**0.25_wp
-       vk        = eta / tauk
-
-       ao = ( 11.0_wp + 7.0_wp * lambda_re ) / ( 205.0_wp + lambda_re )
-       tt = SQRT( 2.0_wp * lambda_re / ( SQRT( 15.0_wp ) * ao ) ) * tauk
-
-!
-!--    Get terminal velocity of droplets
-       CALL fallg
-
-       DO  i = 1, radius_classes
-          tau(i) = winf(i) / g    ! inertial time scale
-          st(i)  = tau(i) / tauk  ! Stokes number
-       ENDDO
-
-!
-!--    Calculate average radial relative velocity at contact (wrfin)
-       z   = tt / tl
-       be  = SQRT( 2.0_wp ) * lambda / lf
-       bbb = SQRT( 1.0_wp - 2.0_wp * be**2 )
-       d1  = ( 1.0_wp + bbb ) / ( 2.0_wp * bbb )
-       e1  = lf * ( 1.0_wp + bbb ) * 0.5_wp
-       d2  = ( 1.0_wp - bbb ) * 0.5_wp / bbb
-       e2  = lf * ( 1.0_wp - bbb ) * 0.5_wp
-       ccc = SQRT( 1.0_wp - 2.0_wp * z**2 )
-       b1  = ( 1.0_wp + ccc ) * 0.5_wp / ccc
-       c1  = tl * ( 1.0_wp + ccc ) * 0.5_wp
-       b2  = ( 1.0_wp - ccc ) * 0.5_wp / ccc
-       c2  = tl * ( 1.0_wp - ccc ) * 0.5_wp
-
-       DO  i = 1, radius_classes
-
-          v1 = winf(i)
-          t1 = tau(i)
-
-          DO  j = 1, i
-             rrp = radclass(i) + radclass(j)
-             v2  = winf(j)
-             t2  = tau(j)
-
-             v1xysq  = b1 * d1 * phi_w(c1,e1,v1,t1) - b1 * d2 * phi_w(c1,e2,v1,t1) &
-                     - b2 * d1 * phi_w(c2,e1,v1,t1) + b2 * d2 * phi_w(c2,e2,v1,t1)
-             v1xysq  = v1xysq * urms**2 / t1
-             vrms1xy = SQRT( v1xysq )
-
-             v2xysq  = b1 * d1 * phi_w(c1,e1,v2,t2) - b1 * d2 * phi_w(c1,e2,v2,t2) &
-                     - b2 * d1 * phi_w(c2,e1,v2,t2) + b2 * d2 * phi_w(c2,e2,v2,t2)
-             v2xysq  = v2xysq * urms**2 / t2
-             vrms2xy = SQRT( v2xysq )
-
-             IF ( winf(i) >= winf(j) )  THEN
-                v1 = winf(i)
-                t1 = tau(i)
-                v2 = winf(j)
-                t2 = tau(j)
-             ELSE
-                v1 = winf(j)
-                t1 = tau(j)
-                v2 = winf(i)
-                t2 = tau(i)
-             ENDIF
-
-             v1v2xy   =  b1 * d1 * zhi(c1,e1,v1,t1,v2,t2) - &
-                         b1 * d2 * zhi(c1,e2,v1,t1,v2,t2) - &
-                         b2 * d1 * zhi(c2,e1,v1,t1,v2,t2) + &
-                         b2 * d2* zhi(c2,e2,v1,t1,v2,t2)
-             fr       = d1 * EXP( -rrp / e1 ) - d2 * EXP( -rrp / e2 )
-             v1v2xy   = v1v2xy * fr * urms**2 / tau(i) / tau(j)
-             wrtur2xy = vrms1xy**2 + vrms2xy**2 - 2.0_wp * v1v2xy
-             IF ( wrtur2xy < 0.0_wp )  wrtur2xy = 0.0_wp
-             wrgrav2  = pi / 8.0_wp * ( winf(j) - winf(i) )**2
-             wrfin    = SQRT( ( 2.0_wp / pi ) * ( wrtur2xy + wrgrav2) )
-
-!
-!--          Calculate radial distribution function (grfin)
-             IF ( st(j) > st(i) )  THEN
-                sst = st(j)
-             ELSE
-                sst = st(i)
-             ENDIF
-
-             xx = -0.1988_wp * sst**4 + 1.5275_wp * sst**3 - 4.2942_wp *       &
-                   sst**2 + 5.3406_wp * sst
-             IF ( xx < 0.0_wp )  xx = 0.0_wp
-             yy = 0.1886_wp * EXP( 20.306_wp / lambda_re )
-
-             c1_gr  =  xx / ( g / vk * tauk )**yy
-
-             ao_gr  = ao + ( pi / 8.0_wp) * ( g / vk * tauk )**2
-             fao_gr = 20.115_wp * SQRT( ao_gr / lambda_re )
-             rc     = SQRT( fao_gr * ABS( st(j) - st(i) ) ) * eta
-
-             grfin  = ( ( eta**2 + rc**2 ) / ( rrp**2 + rc**2) )**( c1_gr*0.5_wp )
-             IF ( grfin < 1.0_wp )  grfin = 1.0_wp
-
-!
-!--          Calculate general collection kernel (without the consideration of
-!--          collection efficiencies)
-             gck(i,j) = 2.0_wp * pi * rrp**2 * wrfin * grfin
-             gck(j,i) = gck(i,j)
-
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE turbsd
-
-    REAL(wp) FUNCTION phi_w( a, b, vsett, tau0 )
-!
-!--    Function used in the Ayala et al. (2008) analytical model for turbulent
-!--    effects on the collision kernel
-       IMPLICIT NONE
-
-       REAL(wp) ::  a     !<
-       REAL(wp) ::  aa1   !<
-       REAL(wp) ::  b     !<
-       REAL(wp) ::  tau0  !<
-       REAL(wp) ::  vsett !<
-
-       aa1 = 1.0_wp / tau0 + 1.0_wp / a + vsett / b
-       phi_w = 1.0_wp / aa1  - 0.5_wp * vsett / b / aa1**2
-
-    END FUNCTION phi_w
-
-    REAL(wp) FUNCTION zhi( a, b, vsett1, tau1, vsett2, tau2 )
-!
-!--    Function used in the Ayala et al. (2008) analytical model for turbulent
-!--    effects on the collision kernel
-       IMPLICIT NONE
-
-       REAL(wp) ::  a      !<
-       REAL(wp) ::  aa1    !<
-       REAL(wp) ::  aa2    !<
-       REAL(wp) ::  aa3    !<
-       REAL(wp) ::  aa4    !<
-       REAL(wp) ::  aa5    !<
-       REAL(wp) ::  aa6    !<
-       REAL(wp) ::  b      !<
-       REAL(wp) ::  tau1   !<
-       REAL(wp) ::  tau2   !<
-       REAL(wp) ::  vsett1 !<
-       REAL(wp) ::  vsett2 !<
-
-       aa1 = vsett2 / b - 1.0_wp / tau2 - 1.0_wp / a
-       aa2 = vsett1 / b + 1.0_wp / tau1 + 1.0_wp / a
-       aa3 = ( vsett1 - vsett2 ) / b + 1.0_wp / tau1 + 1.0_wp / tau2
-       aa4 = ( vsett2 / b )**2 - ( 1.0_wp / tau2 + 1.0_wp / a )**2
-       aa5 = vsett2 / b + 1.0_wp / tau2 + 1.0_wp / a
-       aa6 = 1.0_wp / tau1 - 1.0_wp / a + ( 1.0_wp / tau2 + 1.0_wp / a) *      &
-             vsett1 / vsett2
-       zhi = (1.0_wp / aa1 - 1.0_wp / aa2 ) * ( vsett1 - vsett2 ) * 0.5_wp /   &
-             b / aa3**2 + ( 4.0_wp / aa4 - 1.0_wp / aa5**2 - 1.0_wp / aa1**2 ) &
-             * vsett2 * 0.5_wp / b /aa6 + ( 2.0_wp * ( b / aa2 - b / aa1 ) -   &
-             vsett1 / aa2**2 + vsett2 / aa1**2 ) * 0.5_wp / b / aa3
-
-    END FUNCTION zhi
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Parameterization of terminal velocity following Rogers et al. (1993, J. Appl.
-!> Meteorol.)
-!------------------------------------------------------------------------------!
-    SUBROUTINE fallg
-
-       USE particle_attributes,                                                &
-           ONLY:  radius_classes
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  j                            !<
-
-       REAL(wp), PARAMETER ::  k_cap_rog = 4.0_wp    !< parameter
-       REAL(wp), PARAMETER ::  k_low_rog = 12.0_wp   !< parameter
-       REAL(wp), PARAMETER ::  a_rog     = 9.65_wp   !< parameter
-       REAL(wp), PARAMETER ::  b_rog     = 10.43_wp  !< parameter
-       REAL(wp), PARAMETER ::  c_rog     = 0.6_wp    !< parameter
-       REAL(wp), PARAMETER ::  d0_rog    = 0.745_wp  !< seperation diameter
-
-       REAL(wp)            ::  diameter              !< droplet diameter in mm
-
-
-       DO  j = 1, radius_classes
-
-          diameter = radclass(j) * 2000.0_wp
-
-          IF ( diameter <= d0_rog )  THEN
-             winf(j) = k_cap_rog * diameter * ( 1.0_wp -                       &
-                                                EXP( -k_low_rog * diameter ) )
-          ELSE
-             winf(j) = a_rog - b_rog * EXP( -c_rog * diameter )
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE fallg
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interpolation of collision efficiencies (Hall, 1980, J. Atmos. Sci.)
-!------------------------------------------------------------------------------!
-    SUBROUTINE effic
- 
-       USE particle_attributes,                                                &
-           ONLY:  radius_classes
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i  !<
-       INTEGER(iwp) ::  iq !<
-       INTEGER(iwp) ::  ir !<
-       INTEGER(iwp) ::  j  !<
-       INTEGER(iwp) ::  k  !<
-
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ira !<
-
-       LOGICAL, SAVE ::  first = .TRUE. !<
-
-       REAL(wp) ::  ek              !<
-       REAL(wp) ::  particle_radius !<
-       REAL(wp) ::  pp              !<
-       REAL(wp) ::  qq              !<
-       REAL(wp) ::  rq              !<
-
-       REAL(wp), DIMENSION(1:21), SAVE ::  rat        !<
-       
-       REAL(wp), DIMENSION(1:15), SAVE ::  r0         !<
-       
-       REAL(wp), DIMENSION(1:15,1:21), SAVE ::  ecoll !<
-
-!
-!--    Initial assignment of constants
-       IF ( first )  THEN
-
-         first = .FALSE.
-         r0  = (/   6.0_wp,   8.0_wp,  10.0_wp, 15.0_wp,  20.0_wp,  25.0_wp,   &
-                   30.0_wp,  40.0_wp,  50.0_wp, 60.0_wp,  70.0_wp, 100.0_wp,   &
-                  150.0_wp, 200.0_wp, 300.0_wp /)
-
-         rat = (/ 0.00_wp, 0.05_wp, 0.10_wp, 0.15_wp, 0.20_wp, 0.25_wp,        &
-                  0.30_wp, 0.35_wp, 0.40_wp, 0.45_wp, 0.50_wp, 0.55_wp,        &
-                  0.60_wp, 0.65_wp, 0.70_wp, 0.75_wp, 0.80_wp, 0.85_wp,        &
-                  0.90_wp, 0.95_wp, 1.00_wp /)
-
-         ecoll(:,1)  = (/ 0.001_wp, 0.001_wp, 0.001_wp, 0.001_wp, 0.001_wp,    &
-                          0.001_wp, 0.001_wp, 0.001_wp, 0.001_wp, 0.001_wp,    &
-                          0.001_wp, 0.001_wp, 0.001_wp, 0.001_wp, 0.001_wp /)
-         ecoll(:,2)  = (/ 0.003_wp, 0.003_wp, 0.003_wp, 0.004_wp, 0.005_wp,    &
-                          0.005_wp, 0.005_wp, 0.010_wp, 0.100_wp, 0.050_wp,    &
-                          0.200_wp, 0.500_wp, 0.770_wp, 0.870_wp, 0.970_wp /)
-         ecoll(:,3)  = (/ 0.007_wp, 0.007_wp, 0.007_wp, 0.008_wp, 0.009_wp,    &
-                          0.010_wp, 0.010_wp, 0.070_wp, 0.400_wp, 0.430_wp,    &
-                          0.580_wp, 0.790_wp, 0.930_wp, 0.960_wp, 1.000_wp /)
-         ecoll(:,4)  = (/ 0.009_wp, 0.009_wp, 0.009_wp, 0.012_wp, 0.015_wp,    &
-                          0.010_wp, 0.020_wp, 0.280_wp, 0.600_wp, 0.640_wp,    &
-                          0.750_wp, 0.910_wp, 0.970_wp, 0.980_wp, 1.000_wp /)
-         ecoll(:,5)  = (/ 0.014_wp, 0.014_wp, 0.014_wp, 0.015_wp, 0.016_wp,    &
-                          0.030_wp, 0.060_wp, 0.500_wp, 0.700_wp, 0.770_wp,    &
-                          0.840_wp, 0.950_wp, 0.970_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,6)  = (/ 0.017_wp, 0.017_wp, 0.017_wp, 0.020_wp, 0.022_wp,    &
-                          0.060_wp, 0.100_wp, 0.620_wp, 0.780_wp, 0.840_wp,    &
-                          0.880_wp, 0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,7)  = (/ 0.030_wp, 0.030_wp, 0.024_wp, 0.022_wp, 0.032_wp,    &
-                          0.062_wp, 0.200_wp, 0.680_wp, 0.830_wp, 0.870_wp,    &
-                          0.900_wp, 0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,8)  = (/ 0.025_wp, 0.025_wp, 0.025_wp, 0.036_wp, 0.043_wp,    &
-                          0.130_wp, 0.270_wp, 0.740_wp, 0.860_wp, 0.890_wp,    &
-                          0.920_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,9)  = (/ 0.027_wp, 0.027_wp, 0.027_wp, 0.040_wp, 0.052_wp,    &
-                          0.200_wp, 0.400_wp, 0.780_wp, 0.880_wp, 0.900_wp,    &
-                          0.940_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,10) = (/ 0.030_wp, 0.030_wp, 0.030_wp, 0.047_wp, 0.064_wp,    &
-                          0.250_wp, 0.500_wp, 0.800_wp, 0.900_wp, 0.910_wp,    &
-                          0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,11) = (/ 0.040_wp, 0.040_wp, 0.033_wp, 0.037_wp, 0.068_wp,    &
-                          0.240_wp, 0.550_wp, 0.800_wp, 0.900_wp, 0.910_wp,    &
-                          0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,12) = (/ 0.035_wp, 0.035_wp, 0.035_wp, 0.055_wp, 0.079_wp,    &
-                          0.290_wp, 0.580_wp, 0.800_wp, 0.900_wp, 0.910_wp,    &
-                          0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,13) = (/ 0.037_wp, 0.037_wp, 0.037_wp, 0.062_wp, 0.082_wp,    &
-                          0.290_wp, 0.590_wp, 0.780_wp, 0.900_wp, 0.910_wp,    &
-                          0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,14) = (/ 0.037_wp, 0.037_wp, 0.037_wp, 0.060_wp, 0.080_wp,    &
-                          0.290_wp, 0.580_wp, 0.770_wp, 0.890_wp, 0.910_wp,    &
-                          0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,15) = (/ 0.037_wp, 0.037_wp, 0.037_wp, 0.041_wp, 0.075_wp,    &
-                          0.250_wp, 0.540_wp, 0.760_wp, 0.880_wp, 0.920_wp,    &
-                          0.950_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,16) = (/ 0.037_wp, 0.037_wp, 0.037_wp, 0.052_wp, 0.067_wp,    &
-                          0.250_wp, 0.510_wp, 0.770_wp, 0.880_wp, 0.930_wp,    &
-                          0.970_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,17) = (/ 0.037_wp, 0.037_wp, 0.037_wp, 0.047_wp, 0.057_wp,    &
-                          0.250_wp, 0.490_wp, 0.770_wp, 0.890_wp, 0.950_wp,    &
-                          1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp, 1.000_wp /)
-         ecoll(:,18) = (/ 0.036_wp, 0.036_wp, 0.036_wp, 0.042_wp, 0.048_wp,    &
-                          0.230_wp, 0.470_wp, 0.780_wp, 0.920_wp, 1.000_wp,    &
-                          1.020_wp, 1.020_wp, 1.020_wp, 1.020_wp, 1.020_wp /)
-         ecoll(:,19) = (/ 0.040_wp, 0.040_wp, 0.035_wp, 0.033_wp, 0.040_wp,    &
-                          0.112_wp, 0.450_wp, 0.790_wp, 1.010_wp, 1.030_wp,    &
-                          1.040_wp, 1.040_wp, 1.040_wp, 1.040_wp, 1.040_wp /)
-         ecoll(:,20) = (/ 0.033_wp, 0.033_wp, 0.033_wp, 0.033_wp, 0.033_wp,    &
-                          0.119_wp, 0.470_wp, 0.950_wp, 1.300_wp, 1.700_wp,    &
-                          2.300_wp, 2.300_wp, 2.300_wp, 2.300_wp, 2.300_wp /)
-         ecoll(:,21) = (/ 0.027_wp, 0.027_wp, 0.027_wp, 0.027_wp, 0.027_wp,    &
-                          0.125_wp, 0.520_wp, 1.400_wp, 2.300_wp, 3.000_wp,    &
-                          4.000_wp, 4.000_wp, 4.000_wp, 4.000_wp, 4.000_wp /)
-       ENDIF
-
-!
-!--    Calculate the radius class index of particles with respect to array r
-!--    Radius has to be in microns
-       ALLOCATE( ira(1:radius_classes) )
-       DO  j = 1, radius_classes
-          particle_radius = radclass(j) * 1.0E6_wp
-          DO  k = 1, 15
-             IF ( particle_radius < r0(k) )  THEN
-                ira(j) = k
-                EXIT
-             ENDIF
-          ENDDO
-          IF ( particle_radius >= r0(15) )  ira(j) = 16
-       ENDDO
-
-!
-!--    Two-dimensional linear interpolation of the collision efficiency.
-!--    Radius has to be in microns
-       DO  j = 1, radius_classes
-          DO  i = 1, j
-
-             ir = ira(j)
-             rq = MIN( radclass(i) / radclass(j), radclass(j) / radclass(i) )
-             iq = INT( rq * 20 ) + 1
-             iq = MAX( iq , 2)
-
-             IF ( ir < 16 )  THEN
-                IF ( ir >= 2 )  THEN
-                   pp = ( ( MAX( radclass(j), radclass(i) ) * 1.0E6_wp ) -     &
-                          r0(ir-1) ) / ( r0(ir) - r0(ir-1) )
-                   qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) )
-                   ec(j,i) = ( 1.0_wp - pp ) * ( 1.0_wp - qq )                 &
-                             * ecoll(ir-1,iq-1)                                &
-                             + pp * ( 1.0_wp - qq ) * ecoll(ir,iq-1)           &
-                             + qq * ( 1.0_wp - pp ) * ecoll(ir-1,iq)           &
-                             + pp * qq * ecoll(ir,iq)
-                ELSE
-                   qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) )
-                   ec(j,i) = ( 1.0_wp - qq ) * ecoll(1,iq-1) + qq * ecoll(1,iq)
-                ENDIF
-             ELSE
-                qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) )
-                ek = ( 1.0_wp - qq ) * ecoll(15,iq-1) + qq * ecoll(15,iq)
-                ec(j,i) = MIN( ek, 1.0_wp )
-             ENDIF
-
-             IF ( ec(j,i) < 1.0E-20_wp )  ec(j,i) = 0.0_wp
-
-             ec(i,j) = ec(j,i)
-
-          ENDDO
-       ENDDO
-
-       DEALLOCATE( ira )
-
-    END SUBROUTINE effic
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Interpolation of turbulent enhancement factor for collision efficencies
-!> following Wang and Grabowski (2009, Atmos. Sci. Let.)
-!------------------------------------------------------------------------------!
-    SUBROUTINE turb_enhance_eff
-
-       USE particle_attributes,                                                &
-           ONLY:  radius_classes
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) :: i  !<
-       INTEGER(iwp) :: iq !<
-       INTEGER(iwp) :: ir !<
-       INTEGER(iwp) :: j  !<
-       INTEGER(iwp) :: k  !<
-       INTEGER(iwp) :: kk !<
-
-       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ira !<
-       
-       LOGICAL, SAVE ::  first = .TRUE. !<
-
-       REAL(wp) ::  particle_radius !<
-       REAL(wp) ::  pp              !<
-       REAL(wp) ::  qq              !<
-       REAL(wp) ::  rq              !<
-       REAL(wp) ::  y1              !<
-       REAL(wp) ::  y2              !<
-       REAL(wp) ::  y3              !<
-
-       REAL(wp), DIMENSION(1:11), SAVE ::  rat           !<
-       REAL(wp), DIMENSION(1:7), SAVE  ::  r0            !<
-       
-       REAL(wp), DIMENSION(1:7,1:11), SAVE ::  ecoll_100 !<
-       REAL(wp), DIMENSION(1:7,1:11), SAVE ::  ecoll_400 !<
-
-!
-!--    Initial assignment of constants
-       IF ( first )  THEN
-
-          first = .FALSE.
-
-          r0  = (/  10.0_wp, 20.0_wp, 30.0_wp, 40.0_wp, 50.0_wp, 60.0_wp,  &
-                   100.0_wp /)
-
-          rat = (/ 0.0_wp, 0.1_wp, 0.2_wp, 0.3_wp, 0.4_wp, 0.5_wp, 0.6_wp, &
-                   0.7_wp, 0.8_wp, 0.9_wp, 1.0_wp /)
-!
-!--       Tabulated turbulent enhancement factor at 100 cm**2/s**3
-          ecoll_100(:,1)  = (/  1.74_wp,   1.74_wp,   1.773_wp, 1.49_wp,  &
-                                1.207_wp,  1.207_wp,  1.0_wp /)
-          ecoll_100(:,2)  = (/  1.46_wp,   1.46_wp,   1.421_wp, 1.245_wp, &
-                                1.069_wp,  1.069_wp,  1.0_wp /)
-          ecoll_100(:,3)  = (/  1.32_wp,   1.32_wp,   1.245_wp, 1.123_wp, &
-                                1.000_wp,  1.000_wp,  1.0_wp /)
-          ecoll_100(:,4)  = (/  1.250_wp,  1.250_wp,  1.148_wp, 1.087_wp, &
-                                1.025_wp,  1.025_wp,  1.0_wp /)
-          ecoll_100(:,5)  = (/  1.186_wp,  1.186_wp,  1.066_wp, 1.060_wp, &
-                                1.056_wp,  1.056_wp,  1.0_wp /)
-          ecoll_100(:,6)  = (/  1.045_wp,  1.045_wp,  1.000_wp, 1.014_wp, &
-                                1.028_wp,  1.028_wp,  1.0_wp /)
-          ecoll_100(:,7)  = (/  1.070_wp,  1.070_wp,  1.030_wp, 1.038_wp, &
-                                1.046_wp,  1.046_wp,  1.0_wp /)
-          ecoll_100(:,8)  = (/  1.000_wp,  1.000_wp,  1.054_wp, 1.042_wp, &
-                                1.029_wp,  1.029_wp,  1.0_wp /)
-          ecoll_100(:,9)  = (/  1.223_wp,  1.223_wp,  1.117_wp, 1.069_wp, &
-                                1.021_wp,  1.021_wp,  1.0_wp /)
-          ecoll_100(:,10) = (/  1.570_wp,  1.570_wp,  1.244_wp, 1.166_wp, &
-                                1.088_wp,  1.088_wp,  1.0_wp /)
-          ecoll_100(:,11) = (/ 20.3_wp,   20.3_wp,   14.6_wp,   8.61_wp,  &
-                                2.60_wp,   2.60_wp,   1.0_wp /)
-!
-!--       Tabulated turbulent enhancement factor at 400 cm**2/s**3
-          ecoll_400(:,1)  = (/  4.976_wp,  4.976_wp,  3.593_wp,  2.519_wp, &
-                                1.445_wp,  1.445_wp,  1.0_wp /)
-          ecoll_400(:,2)  = (/  2.984_wp,  2.984_wp,  2.181_wp,  1.691_wp, &
-                                1.201_wp,  1.201_wp,  1.0_wp /)
-          ecoll_400(:,3)  = (/  1.988_wp,  1.988_wp,  1.475_wp,  1.313_wp, &
-                                1.150_wp,  1.150_wp,  1.0_wp /)
-          ecoll_400(:,4)  = (/  1.490_wp,  1.490_wp,  1.187_wp,  1.156_wp, &
-                                1.126_wp,  1.126_wp,  1.0_wp /)
-          ecoll_400(:,5)  = (/  1.249_wp,  1.249_wp,  1.088_wp,  1.090_wp, &
-                                1.092_wp,  1.092_wp,  1.0_wp /)
-          ecoll_400(:,6)  = (/  1.139_wp,  1.139_wp,  1.130_wp,  1.091_wp, &
-                                1.051_wp,  1.051_wp,  1.0_wp /)
-          ecoll_400(:,7)  = (/  1.220_wp,  1.220_wp,  1.190_wp,  1.138_wp, &
-                                1.086_wp,  1.086_wp,  1.0_wp /)
-          ecoll_400(:,8)  = (/  1.325_wp,  1.325_wp,  1.267_wp,  1.165_wp, &
-                                1.063_wp,  1.063_wp,  1.0_wp /)
-          ecoll_400(:,9)  = (/  1.716_wp,  1.716_wp,  1.345_wp,  1.223_wp, &
-                                1.100_wp,  1.100_wp,  1.0_wp /)
-          ecoll_400(:,10) = (/  3.788_wp,  3.788_wp,  1.501_wp,  1.311_wp, &
-                                1.120_wp,  1.120_wp,  1.0_wp /)
-          ecoll_400(:,11) = (/ 36.52_wp,  36.52_wp,  19.16_wp,  22.80_wp,  &
-                               26.0_wp,   26.0_wp,    1.0_wp /)
-
-       ENDIF
-
-!
-!--    Calculate the radius class index of particles with respect to array r0
-!--    The droplet radius has to be given in microns.
-       ALLOCATE( ira(1:radius_classes) )
-
-       DO  j = 1, radius_classes
-          particle_radius = radclass(j) * 1.0E6_wp
-          DO  k = 1, 7
-             IF ( particle_radius < r0(k) )  THEN
-                ira(j) = k
-                EXIT
-             ENDIF
-          ENDDO
-          IF ( particle_radius >= r0(7) )  ira(j) = 8
-       ENDDO
-
-!
-!--    Two-dimensional linear interpolation of the turbulent enhancement factor.
-!--    The droplet radius has to be given in microns.
-       DO  j =  1, radius_classes
-          DO  i = 1, j
-
-             ir = ira(j)
-             rq = MIN( radclass(i) / radclass(j), radclass(j) / radclass(i) )
-
-             DO  kk = 2, 11
-                IF ( rq <= rat(kk) )  THEN
-                   iq = kk
-                   EXIT
-                ENDIF
-             ENDDO
-
-             y1 = 1.0_wp  ! turbulent enhancement factor at 0 m**2/s**3
-
-             IF ( ir < 8 )  THEN
-                IF ( ir >= 2 )  THEN
-                   pp = ( MAX( radclass(j), radclass(i) ) * 1.0E6_wp -  &
-                          r0(ir-1) ) / ( r0(ir) - r0(ir-1) )
-                   qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) )
-                   y2 = ( 1.0_wp - pp ) * ( 1.0_wp - qq ) * ecoll_100(ir-1,iq-1) + &
-                                pp * ( 1.0_wp - qq ) * ecoll_100(ir,iq-1)        + &
-                                qq * ( 1.0_wp - pp ) * ecoll_100(ir-1,iq)        + &
-                                pp * qq              * ecoll_100(ir,iq)
-                   y3 = ( 1.0-pp ) * ( 1.0_wp - qq ) * ecoll_400(ir-1,iq-1)      + &
-                                pp * ( 1.0_wp - qq ) * ecoll_400(ir,iq-1)        + &
-                                qq * ( 1.0_wp - pp ) * ecoll_400(ir-1,iq)        + &
-                                pp * qq              * ecoll_400(ir,iq)
-                ELSE
-                   qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) )
-                   y2 = ( 1.0_wp - qq ) * ecoll_100(1,iq-1) + qq * ecoll_100(1,iq)
-                   y3 = ( 1.0_wp - qq ) * ecoll_400(1,iq-1) + qq * ecoll_400(1,iq)
-                ENDIF
-             ELSE
-                qq = ( rq - rat(iq-1) ) / ( rat(iq) - rat(iq-1) )
-                y2 = ( 1.0_wp - qq ) * ecoll_100(7,iq-1) + qq * ecoll_100(7,iq)
-                y3 = ( 1.0_wp - qq ) * ecoll_400(7,iq-1) + qq * ecoll_400(7,iq)
-             ENDIF
-!
-!--          Linear interpolation of turbulent enhancement factor
-             IF ( epsilon <= 0.01_wp )  THEN
-                ecf(j,i) = ( epsilon - 0.01_wp ) / ( 0.0_wp  - 0.01_wp ) * y1 &
-                         + ( epsilon - 0.0_wp  ) / ( 0.01_wp - 0.0_wp  ) * y2
-             ELSEIF ( epsilon <= 0.06_wp )  THEN
-                ecf(j,i) = ( epsilon - 0.04_wp ) / ( 0.01_wp - 0.04_wp ) * y2 &
-                         + ( epsilon - 0.01_wp ) / ( 0.04_wp - 0.01_wp ) * y3
-             ELSE
-                ecf(j,i) = ( 0.06_wp - 0.04_wp ) / ( 0.01_wp - 0.04_wp ) * y2 &
-                         + ( 0.06_wp - 0.01_wp ) / ( 0.04_wp - 0.01_wp ) * y3
-             ENDIF
-
-             IF ( ecf(j,i) < 1.0_wp )  ecf(j,i) = 1.0_wp
-
-             ecf(i,j) = ecf(j,i)
-
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE turb_enhance_eff
-
- END MODULE lpm_collision_kernels_mod
Index: /palm/trunk/SOURCE/lpm_exchange_horiz.f90
===================================================================
--- /palm/trunk/SOURCE/lpm_exchange_horiz.f90	(revision 1873)
+++ /palm/trunk/SOURCE/lpm_exchange_horiz.f90	(revision 1873)
@@ -0,0 +1,1042 @@
+!> @file lpm_exchange_horiz.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+!
+!
+! 1822 2016-04-07 07:49:42Z hoffmann
+! Tails removed. Unused variables removed.
+!
+! 1783 2016-03-06 18:36:17Z raasch
+! new netcdf-module included
+!
+! 1691 2015-10-26 16:17:44Z maronga
+! Formatting corrections.
+!
+! 1685 2015-10-08 07:32:13Z raasch
+! bugfix concerning vertical index offset in case of ocean
+!
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1359 2014-04-11 17:15:14Z hoffmann
+! New particle structure integrated. 
+! Kind definition added to all floating point numbers.
+! 
+! 1327 2014-03-21 11:00:16Z raasch
+! -netcdf output queries
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1318 2014-03-17 13:35:16Z raasch
+! module interfaces removed
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 851 2012-03-15 14:32:58Z raasch
+! Bugfix: resetting of particle_mask and tail mask moved from end of this
+! routine to lpm
+!
+! 849 2012-03-15 10:35:09Z raasch
+! initial revision (former part of advec_particles)
+!
+!
+! Description:
+! ------------
+! Exchange of particles between the subdomains.
+!------------------------------------------------------------------------------!
+ MODULE lpm_exchange_horiz_mod
+ 
+
+    USE control_parameters,                                                    &
+        ONLY:  dz, message_string, simulated_time
+
+    USE cpulog,                                                                &
+        ONLY:  cpu_log, log_point_s
+
+    USE grid_variables,                                                        &
+        ONLY:  ddx, ddy, dx, dy
+
+    USE indices,                                                               &
+        ONLY:  nx, nxl, nxr, ny, nyn, nys, nzb, nzt
+
+    USE kinds
+
+    USE lpm_pack_arrays_mod,                                                   &
+        ONLY:  lpm_pack_arrays
+
+    USE netcdf_interface,                                                      &
+        ONLY:  netcdf_data_format
+
+    USE particle_attributes,                                                   &
+        ONLY:  alloc_factor, deleted_particles, grid_particles,                &
+               ibc_par_lr, ibc_par_ns, min_nr_particle,                        &
+               mpi_particle_type, number_of_particles,                         &
+               offset_ocean_nzt, offset_ocean_nzt_m1, particles,               &
+               particle_type, prt_count, trlp_count_sum,                       &
+               trlp_count_recv_sum, trnp_count_sum, trnp_count_recv_sum,       &
+               trrp_count_sum, trrp_count_recv_sum, trsp_count_sum,            &
+               trsp_count_recv_sum, zero_particle
+
+    USE pegrid
+
+    IMPLICIT NONE
+
+    INTEGER(iwp), PARAMETER ::  NR_2_direction_move = 10000 !<
+    INTEGER(iwp)            ::  nr_move_north               !<
+    INTEGER(iwp)            ::  nr_move_south               !<
+
+    TYPE(particle_type), DIMENSION(NR_2_direction_move) ::  move_also_north
+    TYPE(particle_type), DIMENSION(NR_2_direction_move) ::  move_also_south
+
+    SAVE
+
+    PRIVATE
+    PUBLIC lpm_exchange_horiz, lpm_move_particle, realloc_particles_array
+
+    INTERFACE lpm_exchange_horiz
+       MODULE PROCEDURE lpm_exchange_horiz
+    END INTERFACE lpm_exchange_horiz
+
+    INTERFACE lpm_move_particle
+       MODULE PROCEDURE lpm_move_particle
+    END INTERFACE lpm_move_particle
+
+    INTERFACE realloc_particles_array
+       MODULE PROCEDURE realloc_particles_array
+    END INTERFACE realloc_particles_array
+
+CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Exchange between subdomains.
+!> As soon as one particle has moved beyond the boundary of the domain, it
+!> is included in the relevant transfer arrays and marked for subsequent
+!> deletion on this PE.
+!> First sweep for crossings in x direction. Find out first the number of
+!> particles to be transferred and allocate temporary arrays needed to store
+!> them.
+!> For a one-dimensional decomposition along y, no transfer is necessary,
+!> because the particle remains on the PE, but the particle coordinate has to
+!> be adjusted.
+!------------------------------------------------------------------------------!
+ SUBROUTINE lpm_exchange_horiz
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i                                       !<
+    INTEGER(iwp) ::  ip                                      !<
+    INTEGER(iwp) ::  j                                       !<
+    INTEGER(iwp) ::  jp                                      !<
+    INTEGER(iwp) ::  kp                                      !<
+    INTEGER(iwp) ::  n                                       !<
+    INTEGER(iwp) ::  trlp_count                              !<
+    INTEGER(iwp) ::  trlp_count_recv                         !<
+    INTEGER(iwp) ::  trlpt_count                             !<
+    INTEGER(iwp) ::  trlpt_count_recv                        !<
+    INTEGER(iwp) ::  trnp_count                              !<
+    INTEGER(iwp) ::  trnp_count_recv                         !<
+    INTEGER(iwp) ::  trnpt_count                             !<
+    INTEGER(iwp) ::  trnpt_count_recv                        !<
+    INTEGER(iwp) ::  trrp_count                              !<
+    INTEGER(iwp) ::  trrp_count_recv                         !<
+    INTEGER(iwp) ::  trrpt_count                             !<
+    INTEGER(iwp) ::  trrpt_count_recv                        !<
+    INTEGER(iwp) ::  trsp_count                              !<
+    INTEGER(iwp) ::  trsp_count_recv                         !<
+    INTEGER(iwp) ::  trspt_count                             !<
+    INTEGER(iwp) ::  trspt_count_recv                        !<
+
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  rvlp  !<
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  rvnp  !<
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  rvrp  !<
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  rvsp  !<
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trlp  !<
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trnp  !<
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trrp  !<
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trsp  !<
+
+    CALL cpu_log( log_point_s(23), 'lpm_exchange_horiz', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Exchange between subdomains.
+!-- As soon as one particle has moved beyond the boundary of the domain, it
+!-- is included in the relevant transfer arrays and marked for subsequent
+!-- deletion on this PE.
+!-- First sweep for crossings in x direction. Find out first the number of
+!-- particles to be transferred and allocate temporary arrays needed to store
+!-- them.
+!-- For a one-dimensional decomposition along y, no transfer is necessary,
+!-- because the particle remains on the PE, but the particle coordinate has to
+!-- be adjusted.
+    trlp_count  = 0
+    trlpt_count = 0
+    trrp_count  = 0
+    trrpt_count = 0
+
+    trlp_count_recv   = 0
+    trlpt_count_recv  = 0
+    trrp_count_recv   = 0
+    trrpt_count_recv  = 0
+
+    IF ( pdims(1) /= 1 )  THEN
+!
+!--    First calculate the storage necessary for sending and receiving the data.
+!--    Compute only first (nxl) and last (nxr) loop iterration.
+       DO  ip = nxl, nxr, nxr - nxl
+          DO  jp = nys, nyn
+             DO  kp = nzb+1, nzt
+
+                number_of_particles = prt_count(kp,jp,ip)
+                IF ( number_of_particles <= 0 )  CYCLE
+                particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
+                DO  n = 1, number_of_particles
+                   IF ( particles(n)%particle_mask )  THEN
+                      i = ( particles(n)%x + 0.5_wp * dx ) * ddx
+   !
+   !--                Above calculation does not work for indices less than zero
+                      IF ( particles(n)%x < -0.5_wp * dx )  i = -1
+
+                      IF ( i < nxl )  THEN
+                         trlp_count = trlp_count + 1
+                      ELSEIF ( i > nxr )  THEN
+                         trrp_count = trrp_count + 1
+                      ENDIF
+                   ENDIF
+                ENDDO
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+       IF ( trlp_count  == 0 )  trlp_count  = 1
+       IF ( trlpt_count == 0 )  trlpt_count = 1
+       IF ( trrp_count  == 0 )  trrp_count  = 1
+       IF ( trrpt_count == 0 )  trrpt_count = 1
+
+       ALLOCATE( trlp(trlp_count), trrp(trrp_count) )
+
+       trlp = zero_particle
+       trrp = zero_particle
+
+       trlp_count  = 0
+       trlpt_count = 0
+       trrp_count  = 0
+       trrpt_count = 0
+
+    ENDIF
+!
+!-- Compute only first (nxl) and last (nxr) loop iterration
+    DO  ip = nxl, nxr,nxr-nxl
+       DO  jp = nys, nyn
+          DO  kp = nzb+1, nzt
+             number_of_particles = prt_count(kp,jp,ip)
+             IF ( number_of_particles <= 0 ) CYCLE
+             particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
+             DO  n = 1, number_of_particles
+!
+!--             Only those particles that have not been marked as 'deleted' may
+!--             be moved.
+                IF ( particles(n)%particle_mask )  THEN
+
+                   i = ( particles(n)%x + 0.5_wp * dx ) * ddx
+   !
+   !--             Above calculation does not work for indices less than zero
+                   IF ( particles(n)%x < - 0.5_wp * dx )  i = -1
+
+                   IF ( i <  nxl )  THEN
+                      IF ( i < 0 )  THEN
+   !
+   !--                   Apply boundary condition along x
+                         IF ( ibc_par_lr == 0 )  THEN
+   !
+   !--                      Cyclic condition
+                            IF ( pdims(1) == 1 )  THEN
+                               particles(n)%x        = ( nx + 1 ) * dx + particles(n)%x
+                               particles(n)%origin_x = ( nx + 1 ) * dx + &
+                               particles(n)%origin_x
+                            ELSE
+                               trlp_count = trlp_count + 1
+                               trlp(trlp_count)   = particles(n)
+                               trlp(trlp_count)%x = ( nx + 1 ) * dx + trlp(trlp_count)%x
+                               trlp(trlp_count)%origin_x = trlp(trlp_count)%origin_x + &
+                               ( nx + 1 ) * dx
+                               particles(n)%particle_mask  = .FALSE.
+                               deleted_particles = deleted_particles + 1
+
+                               IF ( trlp(trlp_count)%x >= (nx + 0.5_wp)* dx - 1.0E-12_wp )  THEN
+                                  trlp(trlp_count)%x = trlp(trlp_count)%x - 1.0E-10_wp
+                                  !++ why is 1 subtracted in next statement???
+                                  trlp(trlp_count)%origin_x = trlp(trlp_count)%origin_x - 1
+                               ENDIF
+
+                            ENDIF
+
+                         ELSEIF ( ibc_par_lr == 1 )  THEN
+   !
+   !--                      Particle absorption
+                            particles(n)%particle_mask = .FALSE.
+                            deleted_particles = deleted_particles + 1
+
+                         ELSEIF ( ibc_par_lr == 2 )  THEN
+   !
+   !--                      Particle reflection
+                            particles(n)%x       = -particles(n)%x
+                            particles(n)%speed_x = -particles(n)%speed_x
+
+                         ENDIF
+                      ELSE
+   !
+   !--                   Store particle data in the transfer array, which will be 
+   !--                   send to the neighbouring PE
+                         trlp_count = trlp_count + 1
+                         trlp(trlp_count) = particles(n)
+                         particles(n)%particle_mask = .FALSE.
+                         deleted_particles = deleted_particles + 1
+
+                      ENDIF
+
+                   ELSEIF ( i > nxr )  THEN
+                      IF ( i > nx )  THEN
+   !
+   !--                   Apply boundary condition along x
+                         IF ( ibc_par_lr == 0 )  THEN
+   !
+   !--                      Cyclic condition
+                            IF ( pdims(1) == 1 )  THEN
+                               particles(n)%x = particles(n)%x - ( nx + 1 ) * dx
+                               particles(n)%origin_x = particles(n)%origin_x - &
+                               ( nx + 1 ) * dx
+                            ELSE
+                               trrp_count = trrp_count + 1
+                               trrp(trrp_count) = particles(n)
+                               trrp(trrp_count)%x = trrp(trrp_count)%x - ( nx + 1 ) * dx
+                               trrp(trrp_count)%origin_x = trrp(trrp_count)%origin_x - &
+                               ( nx + 1 ) * dx
+                               particles(n)%particle_mask = .FALSE.
+                               deleted_particles = deleted_particles + 1
+
+                            ENDIF
+
+                         ELSEIF ( ibc_par_lr == 1 )  THEN
+   !
+   !--                      Particle absorption
+                            particles(n)%particle_mask = .FALSE.
+                            deleted_particles = deleted_particles + 1
+
+                         ELSEIF ( ibc_par_lr == 2 )  THEN
+   !
+   !--                      Particle reflection
+                            particles(n)%x       = 2 * ( nx * dx ) - particles(n)%x
+                            particles(n)%speed_x = -particles(n)%speed_x
+
+                         ENDIF
+                      ELSE
+   !
+   !--                   Store particle data in the transfer array, which will be send
+   !--                   to the neighbouring PE
+                         trrp_count = trrp_count + 1
+                         trrp(trrp_count) = particles(n)
+                         particles(n)%particle_mask = .FALSE.
+                         deleted_particles = deleted_particles + 1
+
+                      ENDIF
+
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Send left boundary, receive right boundary (but first exchange how many
+!-- and check, if particle storage must be extended)
+    IF ( pdims(1) /= 1 )  THEN
+
+       CALL MPI_SENDRECV( trlp_count,      1, MPI_INTEGER, pleft,  0, &
+                          trrp_count_recv, 1, MPI_INTEGER, pright, 0, &
+                          comm2d, status, ierr )
+
+       ALLOCATE(rvrp(MAX(1,trrp_count_recv)))
+
+       CALL MPI_SENDRECV( trlp(1)%radius, max(1,trlp_count), mpi_particle_type,&
+                          pleft, 1, rvrp(1)%radius,                            &
+                          max(1,trrp_count_recv), mpi_particle_type, pright, 1,&
+                          comm2d, status, ierr )
+
+       IF ( trrp_count_recv > 0 )  CALL Add_particles_to_gridcell(rvrp(1:trrp_count_recv))
+
+       DEALLOCATE(rvrp)
+
+!
+!--    Send right boundary, receive left boundary
+       CALL MPI_SENDRECV( trrp_count,      1, MPI_INTEGER, pright, 0, &
+                          trlp_count_recv, 1, MPI_INTEGER, pleft,  0, &
+                          comm2d, status, ierr )
+
+       ALLOCATE(rvlp(MAX(1,trlp_count_recv)))
+
+       CALL MPI_SENDRECV( trrp(1)%radius, max(1,trrp_count), mpi_particle_type,&
+                          pright, 1, rvlp(1)%radius,                           &
+                          max(1,trlp_count_recv), mpi_particle_type, pleft, 1, &
+                          comm2d, status, ierr )
+
+       IF ( trlp_count_recv > 0 )  CALL Add_particles_to_gridcell(rvlp(1:trlp_count_recv))
+
+       DEALLOCATE( rvlp )
+       DEALLOCATE( trlp, trrp )
+
+    ENDIF
+
+
+!
+!-- Check whether particles have crossed the boundaries in y direction. Note 
+!-- that this case can also apply to particles that have just been received
+!-- from the adjacent right or left PE.
+!-- Find out first the number of particles to be transferred and allocate
+!-- temporary arrays needed to store them.
+!-- For a one-dimensional decomposition along x, no transfer is necessary,
+!-- because the particle remains on the PE.
+    trsp_count  = nr_move_south
+    trspt_count = 0
+    trnp_count  = nr_move_north
+    trnpt_count = 0
+
+    trsp_count_recv   = 0
+    trspt_count_recv  = 0
+    trnp_count_recv   = 0
+    trnpt_count_recv  = 0
+
+    IF ( pdims(2) /= 1 )  THEN
+!
+!--    First calculate the storage necessary for sending and receiving the
+!--    data
+       DO  ip = nxl, nxr
+          DO  jp = nys, nyn, nyn-nys                                 !compute only first (nys) and last (nyn) loop iterration
+             DO  kp = nzb+1, nzt
+                number_of_particles = prt_count(kp,jp,ip)
+                IF ( number_of_particles <= 0 )  CYCLE
+                particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
+                DO  n = 1, number_of_particles
+                   IF ( particles(n)%particle_mask )  THEN
+                      j = ( particles(n)%y + 0.5_wp * dy ) * ddy
+!
+!--                   Above calculation does not work for indices less than zero
+                      IF ( particles(n)%y < -0.5_wp * dy )  j = -1
+
+                      IF ( j < nys )  THEN
+                         trsp_count = trsp_count + 1
+                      ELSEIF ( j > nyn )  THEN
+                         trnp_count = trnp_count + 1
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDDO
+
+       IF ( trsp_count  == 0 )  trsp_count  = 1
+       IF ( trspt_count == 0 )  trspt_count = 1
+       IF ( trnp_count  == 0 )  trnp_count  = 1
+       IF ( trnpt_count == 0 )  trnpt_count = 1
+
+       ALLOCATE( trsp(trsp_count), trnp(trnp_count) )
+
+       trsp = zero_particle
+       trnp = zero_particle
+
+       trsp_count  = nr_move_south
+       trspt_count = 0
+       trnp_count  = nr_move_north
+       trnpt_count = 0
+
+       trsp(1:nr_move_south) = move_also_south(1:nr_move_south)
+       trnp(1:nr_move_north) = move_also_north(1:nr_move_north)
+
+    ENDIF
+
+    DO  ip = nxl, nxr
+       DO  jp = nys, nyn, nyn-nys ! compute only first (nys) and last (nyn) loop iterration
+          DO  kp = nzb+1, nzt
+             number_of_particles = prt_count(kp,jp,ip)
+             IF ( number_of_particles <= 0 )  CYCLE
+             particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
+             DO  n = 1, number_of_particles
+!
+!--             Only those particles that have not been marked as 'deleted' may
+!--             be moved.
+                IF ( particles(n)%particle_mask )  THEN
+                   j = ( particles(n)%y + 0.5_wp * dy ) * ddy
+!
+!--                Above calculation does not work for indices less than zero
+                   IF ( particles(n)%y < -0.5_wp * dy )  j = -1
+
+                   IF ( j < nys )  THEN
+                      IF ( j < 0 )  THEN
+!
+!--                      Apply boundary condition along y
+                         IF ( ibc_par_ns == 0 )  THEN
+!
+!--                         Cyclic condition
+                            IF ( pdims(2) == 1 )  THEN
+                               particles(n)%y = ( ny + 1 ) * dy + particles(n)%y
+                               particles(n)%origin_y = ( ny + 1 ) * dy + &
+                               particles(n)%origin_y
+                            ELSE
+                               trsp_count = trsp_count + 1
+                               trsp(trsp_count) = particles(n)
+                               trsp(trsp_count)%y = ( ny + 1 ) * dy + &
+                               trsp(trsp_count)%y
+                               trsp(trsp_count)%origin_y = trsp(trsp_count)%origin_y &
+                               + ( ny + 1 ) * dy
+                               particles(n)%particle_mask = .FALSE.
+                               deleted_particles = deleted_particles + 1
+
+                               IF ( trsp(trsp_count)%y >= (ny+0.5_wp)* dy - 1.0E-12_wp )  THEN
+                                  trsp(trsp_count)%y = trsp(trsp_count)%y - 1.0E-10_wp
+                                  !++ why is 1 subtracted in next statement???
+                                  trsp(trsp_count)%origin_y =                        &
+                                  trsp(trsp_count)%origin_y - 1
+                               ENDIF
+
+                            ENDIF
+
+                         ELSEIF ( ibc_par_ns == 1 )  THEN
+!
+!--                         Particle absorption
+                            particles(n)%particle_mask = .FALSE.
+                            deleted_particles = deleted_particles + 1
+
+                         ELSEIF ( ibc_par_ns == 2 )  THEN
+!
+!--                         Particle reflection
+                            particles(n)%y       = -particles(n)%y
+                            particles(n)%speed_y = -particles(n)%speed_y
+
+                         ENDIF
+                      ELSE
+!
+!--                      Store particle data in the transfer array, which will 
+!--                      be send to the neighbouring PE
+                         trsp_count = trsp_count + 1
+                         trsp(trsp_count) = particles(n)
+                         particles(n)%particle_mask = .FALSE.
+                         deleted_particles = deleted_particles + 1
+
+                      ENDIF
+
+                   ELSEIF ( j > nyn )  THEN
+                      IF ( j > ny )  THEN
+!
+!--                       Apply boundary condition along x
+                         IF ( ibc_par_ns == 0 )  THEN
+!
+!--                         Cyclic condition
+                            IF ( pdims(2) == 1 )  THEN
+                               particles(n)%y = particles(n)%y - ( ny + 1 ) * dy
+                               particles(n)%origin_y =                         &
+                                  particles(n)%origin_y - ( ny + 1 ) * dy
+                            ELSE
+                               trnp_count = trnp_count + 1
+                               trnp(trnp_count) = particles(n)
+                               trnp(trnp_count)%y =                            &
+                                  trnp(trnp_count)%y - ( ny + 1 ) * dy
+                               trnp(trnp_count)%origin_y =                     &
+                                  trnp(trnp_count)%origin_y - ( ny + 1 ) * dy
+                               particles(n)%particle_mask = .FALSE.
+                               deleted_particles = deleted_particles + 1
+                            ENDIF
+
+                         ELSEIF ( ibc_par_ns == 1 )  THEN
+!
+!--                         Particle absorption
+                            particles(n)%particle_mask = .FALSE.
+                            deleted_particles = deleted_particles + 1
+
+                         ELSEIF ( ibc_par_ns == 2 )  THEN
+!
+!--                         Particle reflection
+                            particles(n)%y       = 2 * ( ny * dy ) - particles(n)%y
+                            particles(n)%speed_y = -particles(n)%speed_y
+
+                         ENDIF
+                      ELSE
+!
+!--                      Store particle data in the transfer array, which will 
+!--                      be send to the neighbouring PE
+                         trnp_count = trnp_count + 1
+                         trnp(trnp_count) = particles(n)
+                         particles(n)%particle_mask = .FALSE.
+                         deleted_particles = deleted_particles + 1
+
+                      ENDIF
+
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Send front boundary, receive back boundary (but first exchange how many
+!-- and check, if particle storage must be extended)
+    IF ( pdims(2) /= 1 )  THEN
+
+       CALL MPI_SENDRECV( trsp_count,      1, MPI_INTEGER, psouth, 0, &
+                          trnp_count_recv, 1, MPI_INTEGER, pnorth, 0, &
+                          comm2d, status, ierr )
+
+       ALLOCATE(rvnp(MAX(1,trnp_count_recv)))
+
+       CALL MPI_SENDRECV( trsp(1)%radius, trsp_count, mpi_particle_type,      &
+                          psouth, 1, rvnp(1)%radius,                             &
+                          trnp_count_recv, mpi_particle_type, pnorth, 1,   &
+                          comm2d, status, ierr )
+
+       IF ( trnp_count_recv  > 0 )  CALL Add_particles_to_gridcell(rvnp(1:trnp_count_recv))
+
+       DEALLOCATE(rvnp)
+
+!
+!--    Send back boundary, receive front boundary
+       CALL MPI_SENDRECV( trnp_count,      1, MPI_INTEGER, pnorth, 0, &
+                          trsp_count_recv, 1, MPI_INTEGER, psouth, 0, &
+                          comm2d, status, ierr )
+
+       ALLOCATE(rvsp(MAX(1,trsp_count_recv)))
+
+       CALL MPI_SENDRECV( trnp(1)%radius, trnp_count, mpi_particle_type,      &
+                          pnorth, 1, rvsp(1)%radius,                          &
+                          trsp_count_recv, mpi_particle_type, psouth, 1,   &
+                          comm2d, status, ierr )
+
+       IF ( trsp_count_recv > 0 )  CALL Add_particles_to_gridcell(rvsp(1:trsp_count_recv))
+
+       DEALLOCATE(rvsp)
+
+       number_of_particles = number_of_particles + trsp_count_recv
+
+       DEALLOCATE( trsp, trnp )
+
+    ENDIF
+
+#else
+
+!
+!-- Apply boundary conditions
+    DO  n = 1, number_of_particles
+
+       IF ( particles(n)%x < -0.5_wp * dx )  THEN
+
+          IF ( ibc_par_lr == 0 )  THEN
+!
+!--          Cyclic boundary. Relevant coordinate has to be changed.
+             particles(n)%x = ( nx + 1 ) * dx + particles(n)%x
+
+          ELSEIF ( ibc_par_lr == 1 )  THEN
+!
+!--          Particle absorption
+             particles(n)%particle_mask = .FALSE.
+             deleted_particles = deleted_particles + 1
+
+          ELSEIF ( ibc_par_lr == 2 )  THEN
+!
+!--          Particle reflection
+             particles(n)%x       = -dx - particles(n)%x
+             particles(n)%speed_x = -particles(n)%speed_x
+          ENDIF
+
+       ELSEIF ( particles(n)%x >= ( nx + 0.5_wp ) * dx )  THEN
+
+          IF ( ibc_par_lr == 0 )  THEN
+!
+!--          Cyclic boundary. Relevant coordinate has to be changed.
+             particles(n)%x = particles(n)%x - ( nx + 1 ) * dx
+
+          ELSEIF ( ibc_par_lr == 1 )  THEN
+!
+!--          Particle absorption
+             particles(n)%particle_mask = .FALSE.
+             deleted_particles = deleted_particles + 1
+
+          ELSEIF ( ibc_par_lr == 2 )  THEN
+!
+!--          Particle reflection
+             particles(n)%x       = ( nx + 1 ) * dx - particles(n)%x
+             particles(n)%speed_x = -particles(n)%speed_x
+          ENDIF
+
+       ENDIF
+
+       IF ( particles(n)%y < -0.5_wp * dy )  THEN
+
+          IF ( ibc_par_ns == 0 )  THEN
+!
+!--          Cyclic boundary. Relevant coordinate has to be changed.
+             particles(n)%y = ( ny + 1 ) * dy + particles(n)%y
+
+          ELSEIF ( ibc_par_ns == 1 )  THEN
+!
+!--          Particle absorption
+             particles(n)%particle_mask = .FALSE.
+             deleted_particles = deleted_particles + 1
+
+          ELSEIF ( ibc_par_ns == 2 )  THEN
+!
+!--          Particle reflection
+             particles(n)%y       = -dy - particles(n)%y
+             particles(n)%speed_y = -particles(n)%speed_y
+          ENDIF
+
+       ELSEIF ( particles(n)%y >= ( ny + 0.5_wp ) * dy )  THEN
+
+          IF ( ibc_par_ns == 0 )  THEN
+!
+!--          Cyclic boundary. Relevant coordinate has to be changed.
+             particles(n)%y = particles(n)%y - ( ny + 1 ) * dy
+
+          ELSEIF ( ibc_par_ns == 1 )  THEN
+!
+!--          Particle absorption
+             particles(n)%particle_mask = .FALSE.
+             deleted_particles = deleted_particles + 1
+
+          ELSEIF ( ibc_par_ns == 2 )  THEN
+!
+!--          Particle reflection
+             particles(n)%y       = ( ny + 1 ) * dy - particles(n)%y
+             particles(n)%speed_y = -particles(n)%speed_y
+          ENDIF
+
+       ENDIF
+    ENDDO
+
+#endif
+
+!
+!-- Accumulate the number of particles transferred between the subdomains
+#if defined( __parallel )
+    trlp_count_sum      = trlp_count_sum      + trlp_count
+    trlp_count_recv_sum = trlp_count_recv_sum + trlp_count_recv
+    trrp_count_sum      = trrp_count_sum      + trrp_count
+    trrp_count_recv_sum = trrp_count_recv_sum + trrp_count_recv
+    trsp_count_sum      = trsp_count_sum      + trsp_count
+    trsp_count_recv_sum = trsp_count_recv_sum + trsp_count_recv
+    trnp_count_sum      = trnp_count_sum      + trnp_count
+    trnp_count_recv_sum = trnp_count_recv_sum + trnp_count_recv
+#endif
+
+    CALL cpu_log( log_point_s(23), 'lpm_exchange_horiz', 'stop' )
+
+ END SUBROUTINE lpm_exchange_horiz
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> If a particle moves from one processor to another, this subroutine moves 
+!> the corresponding elements from the particle arrays of the old grid cells 
+!> to the particle arrays of the new grid cells.
+!------------------------------------------------------------------------------!
+ SUBROUTINE Add_particles_to_gridcell (particle_array)
+
+    IMPLICIT NONE
+
+    INTEGER(iwp)        ::  ip        !<
+    INTEGER(iwp)        ::  jp        !<
+    INTEGER(iwp)        ::  kp        !<
+    INTEGER(iwp)        ::  n         !<
+    INTEGER(iwp)        ::  pindex    !<
+
+    LOGICAL             ::  pack_done !<
+
+    TYPE(particle_type), DIMENSION(:), INTENT(IN)       :: particle_array
+
+    pack_done     = .FALSE.
+
+    nr_move_north = 0
+    nr_move_south = 0
+
+    DO n = 1, SIZE(particle_array)
+       ip = ( particle_array(n)%x + 0.5_wp * dx ) * ddx
+       jp = ( particle_array(n)%y + 0.5_wp * dy ) * ddy
+       kp = particle_array(n)%z / dz + 1 + offset_ocean_nzt
+
+       IF ( ip >= nxl  .AND.  ip <= nxr  .AND.  jp >= nys  .AND.  jp <= nyn    &
+            .AND.  kp >= nzb+1  .AND.  kp <= nzt)  THEN ! particle stays on processor
+          number_of_particles = prt_count(kp,jp,ip)
+          particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
+
+          pindex = prt_count(kp,jp,ip)+1
+          IF( pindex > SIZE(grid_particles(kp,jp,ip)%particles) )  THEN
+             IF ( pack_done )  THEN
+                CALL realloc_particles_array (ip,jp,kp)
+             ELSE
+                CALL lpm_pack_arrays
+                prt_count(kp,jp,ip) = number_of_particles
+                pindex = prt_count(kp,jp,ip)+1
+                IF ( pindex > SIZE(grid_particles(kp,jp,ip)%particles) )  THEN
+                   CALL realloc_particles_array (ip,jp,kp)
+                ENDIF
+                pack_done = .TRUE.
+             ENDIF
+          ENDIF
+          grid_particles(kp,jp,ip)%particles(pindex) = particle_array(n)
+          prt_count(kp,jp,ip) = pindex
+       ELSE
+          IF ( jp == nys - 1 )  THEN
+             nr_move_south = nr_move_south+1
+             move_also_south(nr_move_south) = particle_array(n)
+             IF ( jp == -1 )  THEN
+                move_also_south(nr_move_south)%y =                             &
+                   move_also_south(nr_move_south)%y + ( ny + 1 ) * dy
+                move_also_south(nr_move_south)%origin_y =                      &
+                   move_also_south(nr_move_south)%origin_y + ( ny + 1 ) * dy
+             ENDIF
+          ELSEIF ( jp == nyn+1 )  THEN
+             nr_move_north = nr_move_north+1
+             move_also_north(nr_move_north) = particle_array(n)
+             IF ( jp == ny+1 )  THEN
+                move_also_north(nr_move_north)%y =                             &
+                   move_also_north(nr_move_north)%y - ( ny + 1 ) * dy
+                move_also_north(nr_move_north)%origin_y =                      &
+                   move_also_north(nr_move_north)%origin_y - ( ny + 1 ) * dy
+             ENDIF
+          ELSE
+             WRITE(0,'(a,8i7)') 'particle out of range ',myid,ip,jp,kp,nxl,nxr,nys,nyn
+          ENDIF
+       ENDIF
+    ENDDO
+
+    RETURN
+
+ END SUBROUTINE Add_particles_to_gridcell
+
+
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> If a particle moves from one grid cell to another (on the current 
+!> processor!), this subroutine moves the corresponding element from the
+!> particle array of the old grid cell to the particle array of the new grid 
+!> cell.
+!------------------------------------------------------------------------------!
+ SUBROUTINE lpm_move_particle
+
+    IMPLICIT NONE
+
+    INTEGER(iwp)        ::  i           !<
+    INTEGER(iwp)        ::  ip          !<
+    INTEGER(iwp)        ::  j           !<
+    INTEGER(iwp)        ::  jp          !<
+    INTEGER(iwp)        ::  k           !<
+    INTEGER(iwp)        ::  kp          !<
+    INTEGER(iwp)        ::  n           !<
+    INTEGER(iwp)        ::  np_old_cell !<
+    INTEGER(iwp)        ::  n_start     !<
+    INTEGER(iwp)        ::  pindex      !<
+
+    LOGICAL             ::  pack_done   !<
+
+    TYPE(particle_type), DIMENSION(:), POINTER  ::  particles_old_cell !<
+
+    CALL cpu_log( log_point_s(41), 'lpm_move_particle', 'start' )
+
+    DO  ip = nxl, nxr
+       DO  jp = nys, nyn
+          DO  kp = nzb+1, nzt
+
+             np_old_cell = prt_count(kp,jp,ip)
+             IF ( np_old_cell <= 0 )  CYCLE
+             particles_old_cell => grid_particles(kp,jp,ip)%particles(1:np_old_cell)
+             n_start = -1
+             
+             DO  n = 1, np_old_cell
+                i = ( particles_old_cell(n)%x + 0.5_wp * dx ) * ddx
+                j = ( particles_old_cell(n)%y + 0.5_wp * dy ) * ddy
+                k = particles_old_cell(n)%z / dz + 1 + offset_ocean_nzt
+!
+!--             Check, if particle has moved to another grid cell.
+                IF ( i /= ip  .OR.  j /= jp  .OR.  k /= kp )  THEN
+!
+!--                The particle has moved to another grid cell. Now check, if 
+!--                particle stays on the same processor.
+                   IF ( i >= nxl  .AND.  i <= nxr  .AND.  j >= nys  .AND.      &
+                        j <= nyn  .AND.  k >= nzb+1  .AND.  k <= nzt)  THEN
+!
+!--                   If the particle stays on the same processor, the particle
+!--                   will be added to the particle array of the new processor.
+                      number_of_particles = prt_count(k,j,i)
+                      particles => grid_particles(k,j,i)%particles(1:number_of_particles)
+
+                      pindex = prt_count(k,j,i)+1
+                      IF (  pindex > SIZE(grid_particles(k,j,i)%particles)  )  &
+                      THEN
+                         n_start = n
+                         EXIT
+                      ENDIF
+
+                      grid_particles(k,j,i)%particles(pindex) = particles_old_cell(n)
+                      prt_count(k,j,i) = pindex
+
+                      particles_old_cell(n)%particle_mask = .FALSE.
+                   ENDIF
+                ENDIF
+             ENDDO
+
+             IF ( n_start >= 0 )  THEN
+                pack_done = .FALSE.
+                DO  n = n_start, np_old_cell
+                   i = ( particles_old_cell(n)%x + 0.5_wp * dx ) * ddx
+                   j = ( particles_old_cell(n)%y + 0.5_wp * dy ) * ddy
+                   k = particles_old_cell(n)%z / dz + 1 + offset_ocean_nzt
+                   IF ( i /= ip  .OR.  j /= jp  .OR.  k /= kp )  THEN
+!
+!--                   Particle is in different box
+                      IF ( i >= nxl  .AND.  i <= nxr  .AND.  j >= nys  .AND.   &
+                           j <= nyn  .AND.  k >= nzb+1  .AND.  k <= nzt)  THEN
+!
+!--                      Particle stays on processor
+                         number_of_particles = prt_count(k,j,i)
+                         particles => grid_particles(k,j,i)%particles(1:number_of_particles)
+
+                         pindex = prt_count(k,j,i)+1
+                         IF ( pindex > SIZE(grid_particles(k,j,i)%particles) ) &
+                         THEN
+                            IF ( pack_done )  THEN
+                               CALL realloc_particles_array(i,j,k)
+                               pindex = prt_count(k,j,i)+1
+                            ELSE
+                               CALL lpm_pack_arrays
+                               prt_count(k,j,i) = number_of_particles
+
+                               pindex = prt_count(k,j,i)+1
+!
+!--                            If number of particles in the new grid box 
+!--                            exceeds its allocated memory, the particle array
+!--                            will be reallocated
+                               IF ( pindex > SIZE(grid_particles(k,j,i)%particles) )  THEN
+                                  CALL realloc_particles_array(i,j,k)
+                                  pindex = prt_count(k,j,i)+1
+                               ENDIF
+
+                               pack_done = .TRUE.
+                            ENDIF
+                         ENDIF
+
+                         grid_particles(k,j,i)%particles(pindex) = particles_old_cell(n)
+                         prt_count(k,j,i) = pindex
+
+                         particles_old_cell(n)%particle_mask = .FALSE.
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDDO
+
+    CALL cpu_log( log_point_s(41), 'lpm_move_particle', 'stop' )
+
+    RETURN
+
+ END SUBROUTINE lpm_move_particle
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> @todo Missing subroutine description.
+!------------------------------------------------------------------------------!
+ SUBROUTINE realloc_particles_array (i,j,k,size_in)
+
+    IMPLICIT NONE
+
+    INTEGER(iwp), INTENT(in)                       ::  i              !<
+    INTEGER(iwp), INTENT(in)                       ::  j              !<
+    INTEGER(iwp), INTENT(in)                       ::  k              !<
+    INTEGER(iwp), INTENT(in), OPTIONAL             ::  size_in        !<
+
+    INTEGER(iwp)                                   :: old_size        !<
+    INTEGER(iwp)                                   :: new_size        !<
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: tmp_particles_d !<
+    TYPE(particle_type), DIMENSION(500)            :: tmp_particles_s !<
+
+
+    old_size = SIZE(grid_particles(k,j,i)%particles)
+
+    IF ( PRESENT(size_in) )   THEN
+       new_size = size_in
+    ELSE
+       new_size = old_size * ( 1.0_wp + alloc_factor / 100.0_wp )
+    ENDIF
+
+    new_size = MAX( new_size, min_nr_particle )
+
+    IF ( old_size <= 500 )  THEN
+
+       tmp_particles_s(1:old_size) = grid_particles(k,j,i)%particles(1:old_size)
+
+       DEALLOCATE(grid_particles(k,j,i)%particles)
+       ALLOCATE(grid_particles(k,j,i)%particles(new_size))
+
+       grid_particles(k,j,i)%particles(1:old_size)          = tmp_particles_s(1:old_size)
+       grid_particles(k,j,i)%particles(old_size+1:new_size) = zero_particle
+
+    ELSE
+
+       ALLOCATE(tmp_particles_d(new_size))
+       tmp_particles_d(1:old_size) = grid_particles(k,j,i)%particles
+
+       DEALLOCATE(grid_particles(k,j,i)%particles)
+       ALLOCATE(grid_particles(k,j,i)%particles(new_size))
+
+       grid_particles(k,j,i)%particles(1:old_size)          = tmp_particles_d(1:old_size)
+       grid_particles(k,j,i)%particles(old_size+1:new_size) = zero_particle
+
+       DEALLOCATE(tmp_particles_d)
+
+    ENDIF
+    particles => grid_particles(k,j,i)%particles(1:number_of_particles)
+
+    RETURN
+ END SUBROUTINE realloc_particles_array
+
+END MODULE lpm_exchange_horiz_mod
Index: lm/trunk/SOURCE/lpm_exchange_horiz_mod.f90
===================================================================
--- /palm/trunk/SOURCE/lpm_exchange_horiz_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,1041 +1,0 @@
-!> @file lpm_exchange_horiz_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-!
-!
-! 1822 2016-04-07 07:49:42Z hoffmann
-! Tails removed. Unused variables removed.
-!
-! 1783 2016-03-06 18:36:17Z raasch
-! new netcdf-module included
-!
-! 1691 2015-10-26 16:17:44Z maronga
-! Formatting corrections.
-!
-! 1685 2015-10-08 07:32:13Z raasch
-! bugfix concerning vertical index offset in case of ocean
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1359 2014-04-11 17:15:14Z hoffmann
-! New particle structure integrated. 
-! Kind definition added to all floating point numbers.
-! 
-! 1327 2014-03-21 11:00:16Z raasch
-! -netcdf output queries
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1318 2014-03-17 13:35:16Z raasch
-! module interfaces removed
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 851 2012-03-15 14:32:58Z raasch
-! Bugfix: resetting of particle_mask and tail mask moved from end of this
-! routine to lpm
-!
-! 849 2012-03-15 10:35:09Z raasch
-! initial revision (former part of advec_particles)
-!
-!
-! Description:
-! ------------
-! Exchange of particles between the subdomains.
-!------------------------------------------------------------------------------!
- MODULE lpm_exchange_horiz_mod
- 
-
-    USE control_parameters,                                                    &
-        ONLY:  dz, message_string, simulated_time
-
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point_s
-
-    USE grid_variables,                                                        &
-        ONLY:  ddx, ddy, dx, dy
-
-    USE indices,                                                               &
-        ONLY:  nx, nxl, nxr, ny, nyn, nys, nzb, nzt
-
-    USE kinds
-
-    USE lpm_pack_arrays_mod,                                                   &
-        ONLY:  lpm_pack_arrays
-
-    USE netcdf_interface,                                                      &
-        ONLY:  netcdf_data_format
-
-    USE particle_attributes,                                                   &
-        ONLY:  alloc_factor, deleted_particles, grid_particles,                &
-               ibc_par_lr, ibc_par_ns, min_nr_particle,                        &
-               mpi_particle_type, number_of_particles,                         &
-               offset_ocean_nzt, offset_ocean_nzt_m1, particles,               &
-               particle_type, prt_count, trlp_count_sum,                       &
-               trlp_count_recv_sum, trnp_count_sum, trnp_count_recv_sum,       &
-               trrp_count_sum, trrp_count_recv_sum, trsp_count_sum,            &
-               trsp_count_recv_sum, zero_particle
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), PARAMETER ::  NR_2_direction_move = 10000 !<
-    INTEGER(iwp)            ::  nr_move_north               !<
-    INTEGER(iwp)            ::  nr_move_south               !<
-
-    TYPE(particle_type), DIMENSION(NR_2_direction_move) ::  move_also_north
-    TYPE(particle_type), DIMENSION(NR_2_direction_move) ::  move_also_south
-
-    SAVE
-
-    PRIVATE
-    PUBLIC lpm_exchange_horiz, lpm_move_particle, realloc_particles_array
-
-    INTERFACE lpm_exchange_horiz
-       MODULE PROCEDURE lpm_exchange_horiz
-    END INTERFACE lpm_exchange_horiz
-
-    INTERFACE lpm_move_particle
-       MODULE PROCEDURE lpm_move_particle
-    END INTERFACE lpm_move_particle
-
-    INTERFACE realloc_particles_array
-       MODULE PROCEDURE realloc_particles_array
-    END INTERFACE realloc_particles_array
-
-CONTAINS
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Exchange between subdomains.
-!> As soon as one particle has moved beyond the boundary of the domain, it
-!> is included in the relevant transfer arrays and marked for subsequent
-!> deletion on this PE.
-!> First sweep for crossings in x direction. Find out first the number of
-!> particles to be transferred and allocate temporary arrays needed to store
-!> them.
-!> For a one-dimensional decomposition along y, no transfer is necessary,
-!> because the particle remains on the PE, but the particle coordinate has to
-!> be adjusted.
-!------------------------------------------------------------------------------!
- SUBROUTINE lpm_exchange_horiz
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i                                       !<
-    INTEGER(iwp) ::  ip                                      !<
-    INTEGER(iwp) ::  j                                       !<
-    INTEGER(iwp) ::  jp                                      !<
-    INTEGER(iwp) ::  kp                                      !<
-    INTEGER(iwp) ::  n                                       !<
-    INTEGER(iwp) ::  trlp_count                              !<
-    INTEGER(iwp) ::  trlp_count_recv                         !<
-    INTEGER(iwp) ::  trlpt_count                             !<
-    INTEGER(iwp) ::  trlpt_count_recv                        !<
-    INTEGER(iwp) ::  trnp_count                              !<
-    INTEGER(iwp) ::  trnp_count_recv                         !<
-    INTEGER(iwp) ::  trnpt_count                             !<
-    INTEGER(iwp) ::  trnpt_count_recv                        !<
-    INTEGER(iwp) ::  trrp_count                              !<
-    INTEGER(iwp) ::  trrp_count_recv                         !<
-    INTEGER(iwp) ::  trrpt_count                             !<
-    INTEGER(iwp) ::  trrpt_count_recv                        !<
-    INTEGER(iwp) ::  trsp_count                              !<
-    INTEGER(iwp) ::  trsp_count_recv                         !<
-    INTEGER(iwp) ::  trspt_count                             !<
-    INTEGER(iwp) ::  trspt_count_recv                        !<
-
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  rvlp  !<
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  rvnp  !<
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  rvrp  !<
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  rvsp  !<
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trlp  !<
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trnp  !<
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trrp  !<
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  trsp  !<
-
-    CALL cpu_log( log_point_s(23), 'lpm_exchange_horiz', 'start' )
-
-#if defined( __parallel )
-
-!
-!-- Exchange between subdomains.
-!-- As soon as one particle has moved beyond the boundary of the domain, it
-!-- is included in the relevant transfer arrays and marked for subsequent
-!-- deletion on this PE.
-!-- First sweep for crossings in x direction. Find out first the number of
-!-- particles to be transferred and allocate temporary arrays needed to store
-!-- them.
-!-- For a one-dimensional decomposition along y, no transfer is necessary,
-!-- because the particle remains on the PE, but the particle coordinate has to
-!-- be adjusted.
-    trlp_count  = 0
-    trlpt_count = 0
-    trrp_count  = 0
-    trrpt_count = 0
-
-    trlp_count_recv   = 0
-    trlpt_count_recv  = 0
-    trrp_count_recv   = 0
-    trrpt_count_recv  = 0
-
-    IF ( pdims(1) /= 1 )  THEN
-!
-!--    First calculate the storage necessary for sending and receiving the data.
-!--    Compute only first (nxl) and last (nxr) loop iterration.
-       DO  ip = nxl, nxr, nxr - nxl
-          DO  jp = nys, nyn
-             DO  kp = nzb+1, nzt
-
-                number_of_particles = prt_count(kp,jp,ip)
-                IF ( number_of_particles <= 0 )  CYCLE
-                particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
-                DO  n = 1, number_of_particles
-                   IF ( particles(n)%particle_mask )  THEN
-                      i = ( particles(n)%x + 0.5_wp * dx ) * ddx
-   !
-   !--                Above calculation does not work for indices less than zero
-                      IF ( particles(n)%x < -0.5_wp * dx )  i = -1
-
-                      IF ( i < nxl )  THEN
-                         trlp_count = trlp_count + 1
-                      ELSEIF ( i > nxr )  THEN
-                         trrp_count = trrp_count + 1
-                      ENDIF
-                   ENDIF
-                ENDDO
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-       IF ( trlp_count  == 0 )  trlp_count  = 1
-       IF ( trlpt_count == 0 )  trlpt_count = 1
-       IF ( trrp_count  == 0 )  trrp_count  = 1
-       IF ( trrpt_count == 0 )  trrpt_count = 1
-
-       ALLOCATE( trlp(trlp_count), trrp(trrp_count) )
-
-       trlp = zero_particle
-       trrp = zero_particle
-
-       trlp_count  = 0
-       trlpt_count = 0
-       trrp_count  = 0
-       trrpt_count = 0
-
-    ENDIF
-!
-!-- Compute only first (nxl) and last (nxr) loop iterration
-    DO  ip = nxl, nxr,nxr-nxl
-       DO  jp = nys, nyn
-          DO  kp = nzb+1, nzt
-             number_of_particles = prt_count(kp,jp,ip)
-             IF ( number_of_particles <= 0 ) CYCLE
-             particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
-             DO  n = 1, number_of_particles
-!
-!--             Only those particles that have not been marked as 'deleted' may
-!--             be moved.
-                IF ( particles(n)%particle_mask )  THEN
-
-                   i = ( particles(n)%x + 0.5_wp * dx ) * ddx
-   !
-   !--             Above calculation does not work for indices less than zero
-                   IF ( particles(n)%x < - 0.5_wp * dx )  i = -1
-
-                   IF ( i <  nxl )  THEN
-                      IF ( i < 0 )  THEN
-   !
-   !--                   Apply boundary condition along x
-                         IF ( ibc_par_lr == 0 )  THEN
-   !
-   !--                      Cyclic condition
-                            IF ( pdims(1) == 1 )  THEN
-                               particles(n)%x        = ( nx + 1 ) * dx + particles(n)%x
-                               particles(n)%origin_x = ( nx + 1 ) * dx + &
-                               particles(n)%origin_x
-                            ELSE
-                               trlp_count = trlp_count + 1
-                               trlp(trlp_count)   = particles(n)
-                               trlp(trlp_count)%x = ( nx + 1 ) * dx + trlp(trlp_count)%x
-                               trlp(trlp_count)%origin_x = trlp(trlp_count)%origin_x + &
-                               ( nx + 1 ) * dx
-                               particles(n)%particle_mask  = .FALSE.
-                               deleted_particles = deleted_particles + 1
-
-                               IF ( trlp(trlp_count)%x >= (nx + 0.5_wp)* dx - 1.0E-12_wp )  THEN
-                                  trlp(trlp_count)%x = trlp(trlp_count)%x - 1.0E-10_wp
-                                  !++ why is 1 subtracted in next statement???
-                                  trlp(trlp_count)%origin_x = trlp(trlp_count)%origin_x - 1
-                               ENDIF
-
-                            ENDIF
-
-                         ELSEIF ( ibc_par_lr == 1 )  THEN
-   !
-   !--                      Particle absorption
-                            particles(n)%particle_mask = .FALSE.
-                            deleted_particles = deleted_particles + 1
-
-                         ELSEIF ( ibc_par_lr == 2 )  THEN
-   !
-   !--                      Particle reflection
-                            particles(n)%x       = -particles(n)%x
-                            particles(n)%speed_x = -particles(n)%speed_x
-
-                         ENDIF
-                      ELSE
-   !
-   !--                   Store particle data in the transfer array, which will be 
-   !--                   send to the neighbouring PE
-                         trlp_count = trlp_count + 1
-                         trlp(trlp_count) = particles(n)
-                         particles(n)%particle_mask = .FALSE.
-                         deleted_particles = deleted_particles + 1
-
-                      ENDIF
-
-                   ELSEIF ( i > nxr )  THEN
-                      IF ( i > nx )  THEN
-   !
-   !--                   Apply boundary condition along x
-                         IF ( ibc_par_lr == 0 )  THEN
-   !
-   !--                      Cyclic condition
-                            IF ( pdims(1) == 1 )  THEN
-                               particles(n)%x = particles(n)%x - ( nx + 1 ) * dx
-                               particles(n)%origin_x = particles(n)%origin_x - &
-                               ( nx + 1 ) * dx
-                            ELSE
-                               trrp_count = trrp_count + 1
-                               trrp(trrp_count) = particles(n)
-                               trrp(trrp_count)%x = trrp(trrp_count)%x - ( nx + 1 ) * dx
-                               trrp(trrp_count)%origin_x = trrp(trrp_count)%origin_x - &
-                               ( nx + 1 ) * dx
-                               particles(n)%particle_mask = .FALSE.
-                               deleted_particles = deleted_particles + 1
-
-                            ENDIF
-
-                         ELSEIF ( ibc_par_lr == 1 )  THEN
-   !
-   !--                      Particle absorption
-                            particles(n)%particle_mask = .FALSE.
-                            deleted_particles = deleted_particles + 1
-
-                         ELSEIF ( ibc_par_lr == 2 )  THEN
-   !
-   !--                      Particle reflection
-                            particles(n)%x       = 2 * ( nx * dx ) - particles(n)%x
-                            particles(n)%speed_x = -particles(n)%speed_x
-
-                         ENDIF
-                      ELSE
-   !
-   !--                   Store particle data in the transfer array, which will be send
-   !--                   to the neighbouring PE
-                         trrp_count = trrp_count + 1
-                         trrp(trrp_count) = particles(n)
-                         particles(n)%particle_mask = .FALSE.
-                         deleted_particles = deleted_particles + 1
-
-                      ENDIF
-
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Send left boundary, receive right boundary (but first exchange how many
-!-- and check, if particle storage must be extended)
-    IF ( pdims(1) /= 1 )  THEN
-
-       CALL MPI_SENDRECV( trlp_count,      1, MPI_INTEGER, pleft,  0, &
-                          trrp_count_recv, 1, MPI_INTEGER, pright, 0, &
-                          comm2d, status, ierr )
-
-       ALLOCATE(rvrp(MAX(1,trrp_count_recv)))
-
-       CALL MPI_SENDRECV( trlp(1)%radius, max(1,trlp_count), mpi_particle_type,&
-                          pleft, 1, rvrp(1)%radius,                            &
-                          max(1,trrp_count_recv), mpi_particle_type, pright, 1,&
-                          comm2d, status, ierr )
-
-       IF ( trrp_count_recv > 0 )  CALL Add_particles_to_gridcell(rvrp(1:trrp_count_recv))
-
-       DEALLOCATE(rvrp)
-
-!
-!--    Send right boundary, receive left boundary
-       CALL MPI_SENDRECV( trrp_count,      1, MPI_INTEGER, pright, 0, &
-                          trlp_count_recv, 1, MPI_INTEGER, pleft,  0, &
-                          comm2d, status, ierr )
-
-       ALLOCATE(rvlp(MAX(1,trlp_count_recv)))
-
-       CALL MPI_SENDRECV( trrp(1)%radius, max(1,trrp_count), mpi_particle_type,&
-                          pright, 1, rvlp(1)%radius,                           &
-                          max(1,trlp_count_recv), mpi_particle_type, pleft, 1, &
-                          comm2d, status, ierr )
-
-       IF ( trlp_count_recv > 0 )  CALL Add_particles_to_gridcell(rvlp(1:trlp_count_recv))
-
-       DEALLOCATE( rvlp )
-       DEALLOCATE( trlp, trrp )
-
-    ENDIF
-
-
-!
-!-- Check whether particles have crossed the boundaries in y direction. Note 
-!-- that this case can also apply to particles that have just been received
-!-- from the adjacent right or left PE.
-!-- Find out first the number of particles to be transferred and allocate
-!-- temporary arrays needed to store them.
-!-- For a one-dimensional decomposition along x, no transfer is necessary,
-!-- because the particle remains on the PE.
-    trsp_count  = nr_move_south
-    trspt_count = 0
-    trnp_count  = nr_move_north
-    trnpt_count = 0
-
-    trsp_count_recv   = 0
-    trspt_count_recv  = 0
-    trnp_count_recv   = 0
-    trnpt_count_recv  = 0
-
-    IF ( pdims(2) /= 1 )  THEN
-!
-!--    First calculate the storage necessary for sending and receiving the
-!--    data
-       DO  ip = nxl, nxr
-          DO  jp = nys, nyn, nyn-nys                                 !compute only first (nys) and last (nyn) loop iterration
-             DO  kp = nzb+1, nzt
-                number_of_particles = prt_count(kp,jp,ip)
-                IF ( number_of_particles <= 0 )  CYCLE
-                particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
-                DO  n = 1, number_of_particles
-                   IF ( particles(n)%particle_mask )  THEN
-                      j = ( particles(n)%y + 0.5_wp * dy ) * ddy
-!
-!--                   Above calculation does not work for indices less than zero
-                      IF ( particles(n)%y < -0.5_wp * dy )  j = -1
-
-                      IF ( j < nys )  THEN
-                         trsp_count = trsp_count + 1
-                      ELSEIF ( j > nyn )  THEN
-                         trnp_count = trnp_count + 1
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDDO
-
-       IF ( trsp_count  == 0 )  trsp_count  = 1
-       IF ( trspt_count == 0 )  trspt_count = 1
-       IF ( trnp_count  == 0 )  trnp_count  = 1
-       IF ( trnpt_count == 0 )  trnpt_count = 1
-
-       ALLOCATE( trsp(trsp_count), trnp(trnp_count) )
-
-       trsp = zero_particle
-       trnp = zero_particle
-
-       trsp_count  = nr_move_south
-       trspt_count = 0
-       trnp_count  = nr_move_north
-       trnpt_count = 0
-
-       trsp(1:nr_move_south) = move_also_south(1:nr_move_south)
-       trnp(1:nr_move_north) = move_also_north(1:nr_move_north)
-
-    ENDIF
-
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn, nyn-nys ! compute only first (nys) and last (nyn) loop iterration
-          DO  kp = nzb+1, nzt
-             number_of_particles = prt_count(kp,jp,ip)
-             IF ( number_of_particles <= 0 )  CYCLE
-             particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
-             DO  n = 1, number_of_particles
-!
-!--             Only those particles that have not been marked as 'deleted' may
-!--             be moved.
-                IF ( particles(n)%particle_mask )  THEN
-                   j = ( particles(n)%y + 0.5_wp * dy ) * ddy
-!
-!--                Above calculation does not work for indices less than zero
-                   IF ( particles(n)%y < -0.5_wp * dy )  j = -1
-
-                   IF ( j < nys )  THEN
-                      IF ( j < 0 )  THEN
-!
-!--                      Apply boundary condition along y
-                         IF ( ibc_par_ns == 0 )  THEN
-!
-!--                         Cyclic condition
-                            IF ( pdims(2) == 1 )  THEN
-                               particles(n)%y = ( ny + 1 ) * dy + particles(n)%y
-                               particles(n)%origin_y = ( ny + 1 ) * dy + &
-                               particles(n)%origin_y
-                            ELSE
-                               trsp_count = trsp_count + 1
-                               trsp(trsp_count) = particles(n)
-                               trsp(trsp_count)%y = ( ny + 1 ) * dy + &
-                               trsp(trsp_count)%y
-                               trsp(trsp_count)%origin_y = trsp(trsp_count)%origin_y &
-                               + ( ny + 1 ) * dy
-                               particles(n)%particle_mask = .FALSE.
-                               deleted_particles = deleted_particles + 1
-
-                               IF ( trsp(trsp_count)%y >= (ny+0.5_wp)* dy - 1.0E-12_wp )  THEN
-                                  trsp(trsp_count)%y = trsp(trsp_count)%y - 1.0E-10_wp
-                                  !++ why is 1 subtracted in next statement???
-                                  trsp(trsp_count)%origin_y =                        &
-                                  trsp(trsp_count)%origin_y - 1
-                               ENDIF
-
-                            ENDIF
-
-                         ELSEIF ( ibc_par_ns == 1 )  THEN
-!
-!--                         Particle absorption
-                            particles(n)%particle_mask = .FALSE.
-                            deleted_particles = deleted_particles + 1
-
-                         ELSEIF ( ibc_par_ns == 2 )  THEN
-!
-!--                         Particle reflection
-                            particles(n)%y       = -particles(n)%y
-                            particles(n)%speed_y = -particles(n)%speed_y
-
-                         ENDIF
-                      ELSE
-!
-!--                      Store particle data in the transfer array, which will 
-!--                      be send to the neighbouring PE
-                         trsp_count = trsp_count + 1
-                         trsp(trsp_count) = particles(n)
-                         particles(n)%particle_mask = .FALSE.
-                         deleted_particles = deleted_particles + 1
-
-                      ENDIF
-
-                   ELSEIF ( j > nyn )  THEN
-                      IF ( j > ny )  THEN
-!
-!--                       Apply boundary condition along x
-                         IF ( ibc_par_ns == 0 )  THEN
-!
-!--                         Cyclic condition
-                            IF ( pdims(2) == 1 )  THEN
-                               particles(n)%y = particles(n)%y - ( ny + 1 ) * dy
-                               particles(n)%origin_y =                         &
-                                  particles(n)%origin_y - ( ny + 1 ) * dy
-                            ELSE
-                               trnp_count = trnp_count + 1
-                               trnp(trnp_count) = particles(n)
-                               trnp(trnp_count)%y =                            &
-                                  trnp(trnp_count)%y - ( ny + 1 ) * dy
-                               trnp(trnp_count)%origin_y =                     &
-                                  trnp(trnp_count)%origin_y - ( ny + 1 ) * dy
-                               particles(n)%particle_mask = .FALSE.
-                               deleted_particles = deleted_particles + 1
-                            ENDIF
-
-                         ELSEIF ( ibc_par_ns == 1 )  THEN
-!
-!--                         Particle absorption
-                            particles(n)%particle_mask = .FALSE.
-                            deleted_particles = deleted_particles + 1
-
-                         ELSEIF ( ibc_par_ns == 2 )  THEN
-!
-!--                         Particle reflection
-                            particles(n)%y       = 2 * ( ny * dy ) - particles(n)%y
-                            particles(n)%speed_y = -particles(n)%speed_y
-
-                         ENDIF
-                      ELSE
-!
-!--                      Store particle data in the transfer array, which will 
-!--                      be send to the neighbouring PE
-                         trnp_count = trnp_count + 1
-                         trnp(trnp_count) = particles(n)
-                         particles(n)%particle_mask = .FALSE.
-                         deleted_particles = deleted_particles + 1
-
-                      ENDIF
-
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Send front boundary, receive back boundary (but first exchange how many
-!-- and check, if particle storage must be extended)
-    IF ( pdims(2) /= 1 )  THEN
-
-       CALL MPI_SENDRECV( trsp_count,      1, MPI_INTEGER, psouth, 0, &
-                          trnp_count_recv, 1, MPI_INTEGER, pnorth, 0, &
-                          comm2d, status, ierr )
-
-       ALLOCATE(rvnp(MAX(1,trnp_count_recv)))
-
-       CALL MPI_SENDRECV( trsp(1)%radius, trsp_count, mpi_particle_type,      &
-                          psouth, 1, rvnp(1)%radius,                             &
-                          trnp_count_recv, mpi_particle_type, pnorth, 1,   &
-                          comm2d, status, ierr )
-
-       IF ( trnp_count_recv  > 0 )  CALL Add_particles_to_gridcell(rvnp(1:trnp_count_recv))
-
-       DEALLOCATE(rvnp)
-
-!
-!--    Send back boundary, receive front boundary
-       CALL MPI_SENDRECV( trnp_count,      1, MPI_INTEGER, pnorth, 0, &
-                          trsp_count_recv, 1, MPI_INTEGER, psouth, 0, &
-                          comm2d, status, ierr )
-
-       ALLOCATE(rvsp(MAX(1,trsp_count_recv)))
-
-       CALL MPI_SENDRECV( trnp(1)%radius, trnp_count, mpi_particle_type,      &
-                          pnorth, 1, rvsp(1)%radius,                          &
-                          trsp_count_recv, mpi_particle_type, psouth, 1,   &
-                          comm2d, status, ierr )
-
-       IF ( trsp_count_recv > 0 )  CALL Add_particles_to_gridcell(rvsp(1:trsp_count_recv))
-
-       DEALLOCATE(rvsp)
-
-       number_of_particles = number_of_particles + trsp_count_recv
-
-       DEALLOCATE( trsp, trnp )
-
-    ENDIF
-
-#else
-
-!
-!-- Apply boundary conditions
-    DO  n = 1, number_of_particles
-
-       IF ( particles(n)%x < -0.5_wp * dx )  THEN
-
-          IF ( ibc_par_lr == 0 )  THEN
-!
-!--          Cyclic boundary. Relevant coordinate has to be changed.
-             particles(n)%x = ( nx + 1 ) * dx + particles(n)%x
-
-          ELSEIF ( ibc_par_lr == 1 )  THEN
-!
-!--          Particle absorption
-             particles(n)%particle_mask = .FALSE.
-             deleted_particles = deleted_particles + 1
-
-          ELSEIF ( ibc_par_lr == 2 )  THEN
-!
-!--          Particle reflection
-             particles(n)%x       = -dx - particles(n)%x
-             particles(n)%speed_x = -particles(n)%speed_x
-          ENDIF
-
-       ELSEIF ( particles(n)%x >= ( nx + 0.5_wp ) * dx )  THEN
-
-          IF ( ibc_par_lr == 0 )  THEN
-!
-!--          Cyclic boundary. Relevant coordinate has to be changed.
-             particles(n)%x = particles(n)%x - ( nx + 1 ) * dx
-
-          ELSEIF ( ibc_par_lr == 1 )  THEN
-!
-!--          Particle absorption
-             particles(n)%particle_mask = .FALSE.
-             deleted_particles = deleted_particles + 1
-
-          ELSEIF ( ibc_par_lr == 2 )  THEN
-!
-!--          Particle reflection
-             particles(n)%x       = ( nx + 1 ) * dx - particles(n)%x
-             particles(n)%speed_x = -particles(n)%speed_x
-          ENDIF
-
-       ENDIF
-
-       IF ( particles(n)%y < -0.5_wp * dy )  THEN
-
-          IF ( ibc_par_ns == 0 )  THEN
-!
-!--          Cyclic boundary. Relevant coordinate has to be changed.
-             particles(n)%y = ( ny + 1 ) * dy + particles(n)%y
-
-          ELSEIF ( ibc_par_ns == 1 )  THEN
-!
-!--          Particle absorption
-             particles(n)%particle_mask = .FALSE.
-             deleted_particles = deleted_particles + 1
-
-          ELSEIF ( ibc_par_ns == 2 )  THEN
-!
-!--          Particle reflection
-             particles(n)%y       = -dy - particles(n)%y
-             particles(n)%speed_y = -particles(n)%speed_y
-          ENDIF
-
-       ELSEIF ( particles(n)%y >= ( ny + 0.5_wp ) * dy )  THEN
-
-          IF ( ibc_par_ns == 0 )  THEN
-!
-!--          Cyclic boundary. Relevant coordinate has to be changed.
-             particles(n)%y = particles(n)%y - ( ny + 1 ) * dy
-
-          ELSEIF ( ibc_par_ns == 1 )  THEN
-!
-!--          Particle absorption
-             particles(n)%particle_mask = .FALSE.
-             deleted_particles = deleted_particles + 1
-
-          ELSEIF ( ibc_par_ns == 2 )  THEN
-!
-!--          Particle reflection
-             particles(n)%y       = ( ny + 1 ) * dy - particles(n)%y
-             particles(n)%speed_y = -particles(n)%speed_y
-          ENDIF
-
-       ENDIF
-    ENDDO
-
-#endif
-
-!
-!-- Accumulate the number of particles transferred between the subdomains
-#if defined( __parallel )
-    trlp_count_sum      = trlp_count_sum      + trlp_count
-    trlp_count_recv_sum = trlp_count_recv_sum + trlp_count_recv
-    trrp_count_sum      = trrp_count_sum      + trrp_count
-    trrp_count_recv_sum = trrp_count_recv_sum + trrp_count_recv
-    trsp_count_sum      = trsp_count_sum      + trsp_count
-    trsp_count_recv_sum = trsp_count_recv_sum + trsp_count_recv
-    trnp_count_sum      = trnp_count_sum      + trnp_count
-    trnp_count_recv_sum = trnp_count_recv_sum + trnp_count_recv
-#endif
-
-    CALL cpu_log( log_point_s(23), 'lpm_exchange_horiz', 'stop' )
-
- END SUBROUTINE lpm_exchange_horiz
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> If a particle moves from one processor to another, this subroutine moves 
-!> the corresponding elements from the particle arrays of the old grid cells 
-!> to the particle arrays of the new grid cells.
-!------------------------------------------------------------------------------!
- SUBROUTINE Add_particles_to_gridcell (particle_array)
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)        ::  ip        !<
-    INTEGER(iwp)        ::  jp        !<
-    INTEGER(iwp)        ::  kp        !<
-    INTEGER(iwp)        ::  n         !<
-    INTEGER(iwp)        ::  pindex    !<
-
-    LOGICAL             ::  pack_done !<
-
-    TYPE(particle_type), DIMENSION(:), INTENT(IN)       :: particle_array
-
-    pack_done     = .FALSE.
-
-    nr_move_north = 0
-    nr_move_south = 0
-
-    DO n = 1, SIZE(particle_array)
-       ip = ( particle_array(n)%x + 0.5_wp * dx ) * ddx
-       jp = ( particle_array(n)%y + 0.5_wp * dy ) * ddy
-       kp = particle_array(n)%z / dz + 1 + offset_ocean_nzt
-
-       IF ( ip >= nxl  .AND.  ip <= nxr  .AND.  jp >= nys  .AND.  jp <= nyn    &
-            .AND.  kp >= nzb+1  .AND.  kp <= nzt)  THEN ! particle stays on processor
-          number_of_particles = prt_count(kp,jp,ip)
-          particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
-
-          pindex = prt_count(kp,jp,ip)+1
-          IF( pindex > SIZE(grid_particles(kp,jp,ip)%particles) )  THEN
-             IF ( pack_done )  THEN
-                CALL realloc_particles_array (ip,jp,kp)
-             ELSE
-                CALL lpm_pack_arrays
-                prt_count(kp,jp,ip) = number_of_particles
-                pindex = prt_count(kp,jp,ip)+1
-                IF ( pindex > SIZE(grid_particles(kp,jp,ip)%particles) )  THEN
-                   CALL realloc_particles_array (ip,jp,kp)
-                ENDIF
-                pack_done = .TRUE.
-             ENDIF
-          ENDIF
-          grid_particles(kp,jp,ip)%particles(pindex) = particle_array(n)
-          prt_count(kp,jp,ip) = pindex
-       ELSE
-          IF ( jp == nys - 1 )  THEN
-             nr_move_south = nr_move_south+1
-             move_also_south(nr_move_south) = particle_array(n)
-             IF ( jp == -1 )  THEN
-                move_also_south(nr_move_south)%y =                             &
-                   move_also_south(nr_move_south)%y + ( ny + 1 ) * dy
-                move_also_south(nr_move_south)%origin_y =                      &
-                   move_also_south(nr_move_south)%origin_y + ( ny + 1 ) * dy
-             ENDIF
-          ELSEIF ( jp == nyn+1 )  THEN
-             nr_move_north = nr_move_north+1
-             move_also_north(nr_move_north) = particle_array(n)
-             IF ( jp == ny+1 )  THEN
-                move_also_north(nr_move_north)%y =                             &
-                   move_also_north(nr_move_north)%y - ( ny + 1 ) * dy
-                move_also_north(nr_move_north)%origin_y =                      &
-                   move_also_north(nr_move_north)%origin_y - ( ny + 1 ) * dy
-             ENDIF
-          ELSE
-             WRITE(0,'(a,8i7)') 'particle out of range ',myid,ip,jp,kp,nxl,nxr,nys,nyn
-          ENDIF
-       ENDIF
-    ENDDO
-
-    RETURN
-
- END SUBROUTINE Add_particles_to_gridcell
-
-
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> If a particle moves from one grid cell to another (on the current 
-!> processor!), this subroutine moves the corresponding element from the
-!> particle array of the old grid cell to the particle array of the new grid 
-!> cell.
-!------------------------------------------------------------------------------!
- SUBROUTINE lpm_move_particle
-
-    IMPLICIT NONE
-
-    INTEGER(iwp)        ::  i           !<
-    INTEGER(iwp)        ::  ip          !<
-    INTEGER(iwp)        ::  j           !<
-    INTEGER(iwp)        ::  jp          !<
-    INTEGER(iwp)        ::  k           !<
-    INTEGER(iwp)        ::  kp          !<
-    INTEGER(iwp)        ::  n           !<
-    INTEGER(iwp)        ::  np_old_cell !<
-    INTEGER(iwp)        ::  n_start     !<
-    INTEGER(iwp)        ::  pindex      !<
-
-    LOGICAL             ::  pack_done   !<
-
-    TYPE(particle_type), DIMENSION(:), POINTER  ::  particles_old_cell !<
-
-    CALL cpu_log( log_point_s(41), 'lpm_move_particle', 'start' )
-
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-          DO  kp = nzb+1, nzt
-
-             np_old_cell = prt_count(kp,jp,ip)
-             IF ( np_old_cell <= 0 )  CYCLE
-             particles_old_cell => grid_particles(kp,jp,ip)%particles(1:np_old_cell)
-             n_start = -1
-             
-             DO  n = 1, np_old_cell
-                i = ( particles_old_cell(n)%x + 0.5_wp * dx ) * ddx
-                j = ( particles_old_cell(n)%y + 0.5_wp * dy ) * ddy
-                k = particles_old_cell(n)%z / dz + 1 + offset_ocean_nzt
-!
-!--             Check, if particle has moved to another grid cell.
-                IF ( i /= ip  .OR.  j /= jp  .OR.  k /= kp )  THEN
-!
-!--                The particle has moved to another grid cell. Now check, if 
-!--                particle stays on the same processor.
-                   IF ( i >= nxl  .AND.  i <= nxr  .AND.  j >= nys  .AND.      &
-                        j <= nyn  .AND.  k >= nzb+1  .AND.  k <= nzt)  THEN
-!
-!--                   If the particle stays on the same processor, the particle
-!--                   will be added to the particle array of the new processor.
-                      number_of_particles = prt_count(k,j,i)
-                      particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-
-                      pindex = prt_count(k,j,i)+1
-                      IF (  pindex > SIZE(grid_particles(k,j,i)%particles)  )  &
-                      THEN
-                         n_start = n
-                         EXIT
-                      ENDIF
-
-                      grid_particles(k,j,i)%particles(pindex) = particles_old_cell(n)
-                      prt_count(k,j,i) = pindex
-
-                      particles_old_cell(n)%particle_mask = .FALSE.
-                   ENDIF
-                ENDIF
-             ENDDO
-
-             IF ( n_start >= 0 )  THEN
-                pack_done = .FALSE.
-                DO  n = n_start, np_old_cell
-                   i = ( particles_old_cell(n)%x + 0.5_wp * dx ) * ddx
-                   j = ( particles_old_cell(n)%y + 0.5_wp * dy ) * ddy
-                   k = particles_old_cell(n)%z / dz + 1 + offset_ocean_nzt
-                   IF ( i /= ip  .OR.  j /= jp  .OR.  k /= kp )  THEN
-!
-!--                   Particle is in different box
-                      IF ( i >= nxl  .AND.  i <= nxr  .AND.  j >= nys  .AND.   &
-                           j <= nyn  .AND.  k >= nzb+1  .AND.  k <= nzt)  THEN
-!
-!--                      Particle stays on processor
-                         number_of_particles = prt_count(k,j,i)
-                         particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-
-                         pindex = prt_count(k,j,i)+1
-                         IF ( pindex > SIZE(grid_particles(k,j,i)%particles) ) &
-                         THEN
-                            IF ( pack_done )  THEN
-                               CALL realloc_particles_array(i,j,k)
-                               pindex = prt_count(k,j,i)+1
-                            ELSE
-                               CALL lpm_pack_arrays
-                               prt_count(k,j,i) = number_of_particles
-
-                               pindex = prt_count(k,j,i)+1
-!
-!--                            If number of particles in the new grid box 
-!--                            exceeds its allocated memory, the particle array
-!--                            will be reallocated
-                               IF ( pindex > SIZE(grid_particles(k,j,i)%particles) )  THEN
-                                  CALL realloc_particles_array(i,j,k)
-                                  pindex = prt_count(k,j,i)+1
-                               ENDIF
-
-                               pack_done = .TRUE.
-                            ENDIF
-                         ENDIF
-
-                         grid_particles(k,j,i)%particles(pindex) = particles_old_cell(n)
-                         prt_count(k,j,i) = pindex
-
-                         particles_old_cell(n)%particle_mask = .FALSE.
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-
-    CALL cpu_log( log_point_s(41), 'lpm_move_particle', 'stop' )
-
-    RETURN
-
- END SUBROUTINE lpm_move_particle
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!------------------------------------------------------------------------------!
- SUBROUTINE realloc_particles_array (i,j,k,size_in)
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(in)                       ::  i              !<
-    INTEGER(iwp), INTENT(in)                       ::  j              !<
-    INTEGER(iwp), INTENT(in)                       ::  k              !<
-    INTEGER(iwp), INTENT(in), OPTIONAL             ::  size_in        !<
-
-    INTEGER(iwp)                                   :: old_size        !<
-    INTEGER(iwp)                                   :: new_size        !<
-    TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: tmp_particles_d !<
-    TYPE(particle_type), DIMENSION(500)            :: tmp_particles_s !<
-
-
-    old_size = SIZE(grid_particles(k,j,i)%particles)
-
-    IF ( PRESENT(size_in) )   THEN
-       new_size = size_in
-    ELSE
-       new_size = old_size * ( 1.0_wp + alloc_factor / 100.0_wp )
-    ENDIF
-
-    new_size = MAX( new_size, min_nr_particle )
-
-    IF ( old_size <= 500 )  THEN
-
-       tmp_particles_s(1:old_size) = grid_particles(k,j,i)%particles(1:old_size)
-
-       DEALLOCATE(grid_particles(k,j,i)%particles)
-       ALLOCATE(grid_particles(k,j,i)%particles(new_size))
-
-       grid_particles(k,j,i)%particles(1:old_size)          = tmp_particles_s(1:old_size)
-       grid_particles(k,j,i)%particles(old_size+1:new_size) = zero_particle
-
-    ELSE
-
-       ALLOCATE(tmp_particles_d(new_size))
-       tmp_particles_d(1:old_size) = grid_particles(k,j,i)%particles
-
-       DEALLOCATE(grid_particles(k,j,i)%particles)
-       ALLOCATE(grid_particles(k,j,i)%particles(new_size))
-
-       grid_particles(k,j,i)%particles(1:old_size)          = tmp_particles_d(1:old_size)
-       grid_particles(k,j,i)%particles(old_size+1:new_size) = zero_particle
-
-       DEALLOCATE(tmp_particles_d)
-
-    ENDIF
-    particles => grid_particles(k,j,i)%particles(1:number_of_particles)
-
-    RETURN
- END SUBROUTINE realloc_particles_array
-
-END MODULE lpm_exchange_horiz_mod
Index: /palm/trunk/SOURCE/lpm_init.f90
===================================================================
--- /palm/trunk/SOURCE/lpm_init.f90	(revision 1873)
+++ /palm/trunk/SOURCE/lpm_init.f90	(revision 1873)
@@ -0,0 +1,1006 @@
+!> @file lpm_init.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1871 2016-04-15 11:46:09Z hoffmann
+! Initialization of aerosols added.
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+!
+! 1831 2016-04-07 13:15:51Z hoffmann
+! curvature_solution_effects moved to particle_attributes
+!
+! 1822 2016-04-07 07:49:42Z hoffmann
+! Unused variables removed.
+!
+! 1783 2016-03-06 18:36:17Z raasch
+! netcdf module added
+!
+! 1725 2015-11-17 13:01:51Z hoffmann 
+! Bugfix: Processor-dependent seed for random function is generated before it is 
+! used.
+!
+! 1691 2015-10-26 16:17:44Z maronga
+! Renamed prandtl_layer to constant_flux_layer.
+!
+! 1685 2015-10-08 07:32:13Z raasch
+! bugfix concerning vertical index offset in case of ocean
+!
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+!
+! 1575 2015-03-27 09:56:27Z raasch
+! initial vertical particle position is allowed to follow the topography
+!
+! 1359 2014-04-11 17:15:14Z hoffmann
+! New particle structure integrated. 
+! Kind definition added to all floating point numbers.
+! lpm_init changed form a subroutine to a module.
+! 
+! 1327 2014-03-21 11:00:16Z raasch
+! -netcdf_output
+!
+! 1322 2014-03-20 16:38:49Z raasch
+! REAL functions provided with KIND-attribute
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+! bugfix: #if defined( __parallel ) added
+!
+! 1314 2014-03-14 18:25:17Z suehring
+! Vertical logarithmic interpolation of horizontal particle speed for particles 
+! between roughness height and first vertical grid level.
+!
+! 1092 2013-02-02 11:24:22Z raasch
+! unused variables removed
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 849 2012-03-15 10:35:09Z raasch
+! routine renamed: init_particles -> lpm_init
+! de_dx, de_dy, de_dz are allocated here (instead of automatic arrays in
+! advec_particles),
+! sort_particles renamed lpm_sort_arrays, user_init_particles renamed lpm_init
+!
+! 828 2012-02-21 12:00:36Z raasch
+! call of init_kernels, particle feature color renamed class
+!
+! 824 2012-02-17 09:09:57Z raasch
+! particle attributes speed_x|y|z_sgs renamed rvar1|2|3,
+! array particles implemented as pointer
+!
+! 667 2010-12-23 12:06:00Z suehring/gryschka
+! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng for allocation 
+! of arrays.
+!
+! Revision 1.1  1999/11/25 16:22:38  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> This routine initializes a set of particles and their attributes (position,
+!> radius, ..) which are used by the Lagrangian particle model (see lpm).
+!------------------------------------------------------------------------------!
+ MODULE lpm_init_mod
+ 
+
+    USE arrays_3d,                                                             &
+        ONLY:  de_dx, de_dy, de_dz, zu, zw, z0
+
+    USE control_parameters,                                                    &
+        ONLY:  cloud_droplets, constant_flux_layer, current_timestep_number,   &
+               dz, initializing_actions, message_string, ocean, simulated_time
+
+    USE grid_variables,                                                        &
+        ONLY:  ddx, dx, ddy, dy
+
+    USE indices,                                                               &
+        ONLY:  nx, nxl, nxlg, nxrg, nxr, ny, nyn, nys, nyng, nysg, nz, nzb,    &
+               nzb_w_inner, nzt
+
+    USE kinds
+
+    USE lpm_collision_kernels_mod,                                             &
+        ONLY:  init_kernels
+
+    USE netcdf_interface,                                                      &
+        ONLY:  netcdf_data_format
+
+    USE particle_attributes,                                                   &
+        ONLY:   alloc_factor, bc_par_b, bc_par_lr, bc_par_ns, bc_par_t,        &
+                block_offset, block_offset_def, collision_kernel,              &
+                curvature_solution_effects,                                    &
+                density_ratio, grid_particles,                                 &
+                initial_weighting_factor, ibc_par_b, ibc_par_lr, ibc_par_ns,   &
+                ibc_par_t, iran_part, log_z_z0,                                &
+                max_number_of_particle_groups, maximum_number_of_particles,    &
+                min_nr_particle, mpi_particle_type,                            &
+                number_of_particles,                                           &
+                number_of_particle_groups, number_of_sublayers,                &
+                offset_ocean_nzt, offset_ocean_nzt_m1,                         &
+                particles, particle_advection_start, particle_groups,          &
+                particle_groups_type, particles_per_point,                     &
+                particle_type, pdx, pdy, pdz,                                  &
+                prt_count, psb, psl, psn, psr, pss, pst,                       &
+                radius, random_start_position, read_particles_from_restartfile,&
+                seed_follows_topography, sort_count,                           &
+                total_number_of_particles,                                     &
+                use_sgs_for_particles,                                         &
+                write_particle_statistics, uniform_particles, zero_particle,   &
+                z0_av_global
+
+    USE pegrid
+
+    USE random_function_mod,                                                   &
+        ONLY:  random_function
+
+    IMPLICIT NONE
+
+    PRIVATE
+
+    INTEGER(iwp), PARAMETER         :: PHASE_INIT    = 1  !<
+    INTEGER(iwp), PARAMETER, PUBLIC :: PHASE_RELEASE = 2  !<
+
+    INTERFACE lpm_init
+       MODULE PROCEDURE lpm_init
+    END INTERFACE lpm_init
+
+    INTERFACE lpm_create_particle
+       MODULE PROCEDURE lpm_create_particle
+    END INTERFACE lpm_create_particle
+
+    PUBLIC lpm_init, lpm_create_particle
+
+CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> @todo Missing subroutine description.
+!------------------------------------------------------------------------------!
+ SUBROUTINE lpm_init
+
+    USE lpm_collision_kernels_mod,                                             &
+        ONLY:  init_kernels
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i                           !<
+    INTEGER(iwp) ::  j                           !<
+    INTEGER(iwp) ::  k                           !<
+
+#if defined( __parallel )
+    INTEGER(iwp), DIMENSION(3) ::  blocklengths  !<
+    INTEGER(iwp), DIMENSION(3) ::  displacements !<
+    INTEGER(iwp), DIMENSION(3) ::  types         !<
+#endif
+
+    REAL(wp) ::  height_int                      !<
+    REAL(wp) ::  height_p                        !<
+    REAL(wp) ::  z_p                             !<
+    REAL(wp) ::  z0_av_local                     !<
+
+#if defined( __parallel )
+!
+!-- Define MPI derived datatype for FORTRAN datatype particle_type (see module
+!-- particle_attributes). Integer length is 4 byte, Real is 8 byte
+    blocklengths(1)  = 19;  blocklengths(2)  =   6;  blocklengths(3)  =   1
+    displacements(1) =  0;  displacements(2) = 152;  displacements(3) = 176
+
+    types(1) = MPI_REAL
+    types(2) = MPI_INTEGER
+    types(3) = MPI_UB
+    CALL MPI_TYPE_STRUCT( 3, blocklengths, displacements, types, &
+                          mpi_particle_type, ierr )
+    CALL MPI_TYPE_COMMIT( mpi_particle_type, ierr )
+#endif
+
+!
+!-- In case of oceans runs, the vertical index calculations need an offset,
+!-- because otherwise the k indices will become negative
+    IF ( ocean )  THEN
+       offset_ocean_nzt    = nzt
+       offset_ocean_nzt_m1 = nzt - 1
+    ENDIF
+
+!
+!-- Define block offsets for dividing a gridcell in 8 sub cells
+
+    block_offset(0) = block_offset_def (-1,-1,-1)
+    block_offset(1) = block_offset_def (-1,-1, 0)
+    block_offset(2) = block_offset_def (-1, 0,-1)
+    block_offset(3) = block_offset_def (-1, 0, 0)
+    block_offset(4) = block_offset_def ( 0,-1,-1)
+    block_offset(5) = block_offset_def ( 0,-1, 0)
+    block_offset(6) = block_offset_def ( 0, 0,-1)
+    block_offset(7) = block_offset_def ( 0, 0, 0)
+!
+!-- Check the number of particle groups.
+    IF ( number_of_particle_groups > max_number_of_particle_groups )  THEN
+       WRITE( message_string, * ) 'max_number_of_particle_groups =',      &
+                                  max_number_of_particle_groups ,         &
+                                  '&number_of_particle_groups reset to ', &
+                                  max_number_of_particle_groups
+       CALL message( 'lpm_init', 'PA0213', 0, 1, 0, 6, 0 )
+       number_of_particle_groups = max_number_of_particle_groups
+    ENDIF
+
+!
+!-- Set default start positions, if necessary
+    IF ( psl(1) == 9999999.9_wp )  psl(1) = -0.5_wp * dx
+    IF ( psr(1) == 9999999.9_wp )  psr(1) = ( nx + 0.5_wp ) * dx
+    IF ( pss(1) == 9999999.9_wp )  pss(1) = -0.5_wp * dy
+    IF ( psn(1) == 9999999.9_wp )  psn(1) = ( ny + 0.5_wp ) * dy
+    IF ( psb(1) == 9999999.9_wp )  psb(1) = zu(nz/2)
+    IF ( pst(1) == 9999999.9_wp )  pst(1) = psb(1)
+
+    IF ( pdx(1) == 9999999.9_wp  .OR.  pdx(1) == 0.0_wp )  pdx(1) = dx
+    IF ( pdy(1) == 9999999.9_wp  .OR.  pdy(1) == 0.0_wp )  pdy(1) = dy
+    IF ( pdz(1) == 9999999.9_wp  .OR.  pdz(1) == 0.0_wp )  pdz(1) = zu(2) - zu(1)
+
+    DO  j = 2, number_of_particle_groups
+       IF ( psl(j) == 9999999.9_wp )  psl(j) = psl(j-1)
+       IF ( psr(j) == 9999999.9_wp )  psr(j) = psr(j-1)
+       IF ( pss(j) == 9999999.9_wp )  pss(j) = pss(j-1)
+       IF ( psn(j) == 9999999.9_wp )  psn(j) = psn(j-1)
+       IF ( psb(j) == 9999999.9_wp )  psb(j) = psb(j-1)
+       IF ( pst(j) == 9999999.9_wp )  pst(j) = pst(j-1)
+       IF ( pdx(j) == 9999999.9_wp  .OR.  pdx(j) == 0.0_wp )  pdx(j) = pdx(j-1)
+       IF ( pdy(j) == 9999999.9_wp  .OR.  pdy(j) == 0.0_wp )  pdy(j) = pdy(j-1)
+       IF ( pdz(j) == 9999999.9_wp  .OR.  pdz(j) == 0.0_wp )  pdz(j) = pdz(j-1)
+    ENDDO
+
+!
+!-- Allocate arrays required for calculating particle SGS velocities
+    IF ( use_sgs_for_particles  .AND.  .NOT. cloud_droplets )  THEN
+       ALLOCATE( de_dx(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
+                 de_dy(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
+                 de_dz(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+    ENDIF
+
+!
+!-- Allocate array required for logarithmic vertical interpolation of 
+!-- horizontal particle velocities between the surface and the first vertical
+!-- grid level. In order to avoid repeated CPU cost-intensive CALLS of 
+!-- intrinsic FORTRAN procedure LOG(z/z0), LOG(z/z0) is precalculated for 
+!-- several heights. Splitting into 20 sublayers turned out to be sufficient. 
+!-- To obtain exact height levels of particles, linear interpolation is applied
+!-- (see lpm_advec.f90).
+    IF ( constant_flux_layer )  THEN
+       
+       ALLOCATE ( log_z_z0(0:number_of_sublayers) ) 
+       z_p         = zu(nzb+1) - zw(nzb)
+
+!
+!--    Calculate horizontal mean value of z0 used for logartihmic
+!--    interpolation. Note: this is not exact for heterogeneous z0. 
+!--    However, sensitivity studies showed that the effect is 
+!--    negligible. 
+       z0_av_local  = SUM( z0(nys:nyn,nxl:nxr) )
+       z0_av_global = 0.0_wp
+
+#if defined( __parallel )
+       CALL MPI_ALLREDUCE(z0_av_local, z0_av_global, 1, MPI_REAL, MPI_SUM, &
+                          comm2d, ierr )
+#else
+       z0_av_global = z0_av_local
+#endif
+
+       z0_av_global = z0_av_global  / ( ( ny + 1 ) * ( nx + 1 ) )
+!
+!--    Horizontal wind speed is zero below and at z0
+       log_z_z0(0) = 0.0_wp
+!
+!--    Calculate vertical depth of the sublayers
+       height_int  = ( z_p - z0_av_global ) / REAL( number_of_sublayers, KIND=wp )
+!
+!--    Precalculate LOG(z/z0)
+       height_p    = 0.0_wp
+       DO  k = 1, number_of_sublayers
+
+          height_p    = height_p + height_int
+          log_z_z0(k) = LOG( height_p / z0_av_global )
+
+       ENDDO
+
+
+    ENDIF
+
+!
+!-- Check boundary condition and set internal variables
+    SELECT CASE ( bc_par_b )
+    
+       CASE ( 'absorb' )
+          ibc_par_b = 1
+
+       CASE ( 'reflect' )
+          ibc_par_b = 2
+          
+       CASE DEFAULT
+          WRITE( message_string, * )  'unknown boundary condition ',   &
+                                       'bc_par_b = "', TRIM( bc_par_b ), '"'
+          CALL message( 'lpm_init', 'PA0217', 1, 2, 0, 6, 0 )
+          
+    END SELECT
+    SELECT CASE ( bc_par_t )
+    
+       CASE ( 'absorb' )
+          ibc_par_t = 1
+
+       CASE ( 'reflect' )
+          ibc_par_t = 2
+          
+       CASE DEFAULT
+          WRITE( message_string, * ) 'unknown boundary condition ',   &
+                                     'bc_par_t = "', TRIM( bc_par_t ), '"'
+          CALL message( 'lpm_init', 'PA0218', 1, 2, 0, 6, 0 )
+          
+    END SELECT
+    SELECT CASE ( bc_par_lr )
+
+       CASE ( 'cyclic' )
+          ibc_par_lr = 0
+
+       CASE ( 'absorb' )
+          ibc_par_lr = 1
+
+       CASE ( 'reflect' )
+          ibc_par_lr = 2
+          
+       CASE DEFAULT
+          WRITE( message_string, * ) 'unknown boundary condition ',   &
+                                     'bc_par_lr = "', TRIM( bc_par_lr ), '"'
+          CALL message( 'lpm_init', 'PA0219', 1, 2, 0, 6, 0 )
+          
+    END SELECT
+    SELECT CASE ( bc_par_ns )
+
+       CASE ( 'cyclic' )
+          ibc_par_ns = 0
+
+       CASE ( 'absorb' )
+          ibc_par_ns = 1
+
+       CASE ( 'reflect' )
+          ibc_par_ns = 2
+          
+       CASE DEFAULT
+          WRITE( message_string, * ) 'unknown boundary condition ',   &
+                                     'bc_par_ns = "', TRIM( bc_par_ns ), '"'
+          CALL message( 'lpm_init', 'PA0220', 1, 2, 0, 6, 0 )
+          
+    END SELECT
+
+!
+!-- Initialize collision kernels
+    IF ( collision_kernel /= 'none' )  CALL init_kernels
+
+!
+!-- For the first model run of a possible job chain initialize the
+!-- particles, otherwise read the particle data from restart file.
+    IF ( TRIM( initializing_actions ) == 'read_restart_data'  &
+         .AND.  read_particles_from_restartfile )  THEN
+
+       CALL lpm_read_restart_file
+
+    ELSE
+
+!
+!--    Allocate particle arrays and set attributes of the initial set of
+!--    particles, which can be also periodically released at later times.
+       ALLOCATE( prt_count(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
+                 grid_particles(nzb+1:nzt,nys:nyn,nxl:nxr) )
+
+       maximum_number_of_particles = 0
+       number_of_particles         = 0
+
+       sort_count = 0
+       prt_count  = 0
+
+!
+!--    Initialize all particles with dummy values (otherwise errors may
+!--    occur within restart runs). The reason for this is still not clear
+!--    and may be presumably caused by errors in the respective user-interface.
+       zero_particle = particle_type( 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp,  &
+                                      0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp,  &
+                                      0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp,  &
+                                      0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0, 0, 0, &
+                                      0, .FALSE., -1)
+
+       particle_groups = particle_groups_type( 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
+
+!
+!--    Set values for the density ratio and radius for all particle
+!--    groups, if necessary
+       IF ( density_ratio(1) == 9999999.9_wp )  density_ratio(1) = 0.0_wp
+       IF ( radius(1)        == 9999999.9_wp )  radius(1) = 0.0_wp
+       DO  i = 2, number_of_particle_groups
+          IF ( density_ratio(i) == 9999999.9_wp )  THEN
+             density_ratio(i) = density_ratio(i-1)
+          ENDIF
+          IF ( radius(i) == 9999999.9_wp )  radius(i) = radius(i-1)
+       ENDDO
+
+       DO  i = 1, number_of_particle_groups
+          IF ( density_ratio(i) /= 0.0_wp  .AND.  radius(i) == 0 )  THEN
+             WRITE( message_string, * ) 'particle group #', i, 'has a', &
+                                        'density ratio /= 0 but radius = 0'
+             CALL message( 'lpm_init', 'PA0215', 1, 2, 0, 6, 0 )
+          ENDIF
+          particle_groups(i)%density_ratio = density_ratio(i)
+          particle_groups(i)%radius        = radius(i)
+       ENDDO
+
+!
+!--    Set a seed value for the random number generator to be exclusively
+!--    used for the particle code. The generated random numbers should be
+!--    different on the different PEs.
+       iran_part = iran_part + myid
+
+       CALL lpm_create_particle (PHASE_INIT)
+
+!
+!--    User modification of initial particles
+       CALL user_lpm_init
+
+!
+!--    Open file for statistical informations about particle conditions
+       IF ( write_particle_statistics )  THEN
+          CALL check_open( 80 )
+          WRITE ( 80, 8000 )  current_timestep_number, simulated_time,         &
+                              number_of_particles,                             &
+                              maximum_number_of_particles
+          CALL close_file( 80 )
+       ENDIF
+
+    ENDIF
+
+!
+!-- To avoid programm abort, assign particles array to the local version of 
+!-- first grid cell
+    number_of_particles = prt_count(nzb+1,nys,nxl)
+    particles => grid_particles(nzb+1,nys,nxl)%particles(1:number_of_particles)
+
+!
+!-- Formats
+8000 FORMAT (I6,1X,F7.2,4X,I10,71X,I10)
+
+ END SUBROUTINE lpm_init
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> @todo Missing subroutine description.
+!------------------------------------------------------------------------------!
+ SUBROUTINE lpm_create_particle (phase)
+
+    USE lpm_exchange_horiz_mod,                                                &
+        ONLY: lpm_exchange_horiz, lpm_move_particle, realloc_particles_array
+
+    USE lpm_pack_arrays_mod,                                                   &
+        ONLY: lpm_pack_all_arrays
+
+    USE particle_attributes,                                                   &
+        ONLY: monodisperse_aerosols
+
+    IMPLICIT  NONE
+
+    INTEGER(iwp)               ::  alloc_size  !<
+    INTEGER(iwp)               ::  i           !<
+    INTEGER(iwp)               ::  ip          !<
+    INTEGER(iwp)               ::  j           !<
+    INTEGER(iwp)               ::  jp          !<
+    INTEGER(iwp)               ::  kp          !<
+    INTEGER(iwp)               ::  loop_stride !<
+    INTEGER(iwp)               ::  n           !<
+    INTEGER(iwp)               ::  new_size    !<
+
+    INTEGER(iwp), INTENT(IN)   ::  phase       !<
+
+    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  local_count !<
+    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  local_start !<
+
+    LOGICAL                    ::  first_stride !<
+
+    REAL(wp)                   ::  pos_x !<
+    REAL(wp)                   ::  pos_y !<
+    REAL(wp)                   ::  pos_z !<
+
+    TYPE(particle_type),TARGET ::  tmp_particle !<
+
+!
+!-- Calculate particle positions and store particle attributes, if
+!-- particle is situated on this PE
+    DO  loop_stride = 1, 2
+       first_stride = (loop_stride == 1)
+       IF ( first_stride )   THEN
+          local_count = 0           ! count number of particles
+       ELSE
+          local_count = prt_count   ! Start address of new particles
+       ENDIF
+
+       n = 0
+       DO  i = 1, number_of_particle_groups
+
+          pos_z = psb(i)
+
+          DO WHILE ( pos_z <= pst(i) )
+
+             pos_y = pss(i)
+
+             DO WHILE ( pos_y <= psn(i) )
+
+                IF ( pos_y >= ( nys - 0.5_wp ) * dy  .AND.  &
+                     pos_y <  ( nyn + 0.5_wp ) * dy )  THEN
+
+                   pos_x = psl(i)
+
+            xloop: DO WHILE ( pos_x <= psr(i) )
+
+                      IF ( pos_x >= ( nxl - 0.5_wp ) * dx  .AND.  &
+                           pos_x <  ( nxr + 0.5_wp ) * dx )  THEN
+
+                         DO  j = 1, particles_per_point
+
+                            n = n + 1
+                            tmp_particle%x             = pos_x
+                            tmp_particle%y             = pos_y
+                            tmp_particle%z             = pos_z
+                            tmp_particle%age           = 0.0_wp
+                            tmp_particle%age_m         = 0.0_wp
+                            tmp_particle%dt_sum        = 0.0_wp
+                            tmp_particle%dvrp_psize    = 0.0_wp !unused
+                            tmp_particle%e_m           = 0.0_wp
+                            IF ( curvature_solution_effects )  THEN
+!
+!--                            Initial values (internal timesteps, derivative)
+!--                            for Rosenbrock method
+                               tmp_particle%rvar1      = 1.0E-6_wp     !last Rosenbrock timestep
+                               tmp_particle%rvar2      = 0.1E-6_wp     !dry aerosol radius
+                               tmp_particle%rvar3      = -9999999.9_wp !unused
+                            ELSE
+!
+!--                            Initial values for SGS velocities
+                               tmp_particle%rvar1      = 0.0_wp
+                               tmp_particle%rvar2      = 0.0_wp
+                               tmp_particle%rvar3      = 0.0_wp
+                            ENDIF
+                            tmp_particle%speed_x       = 0.0_wp
+                            tmp_particle%speed_y       = 0.0_wp
+                            tmp_particle%speed_z       = 0.0_wp
+                            tmp_particle%origin_x      = pos_x
+                            tmp_particle%origin_y      = pos_y
+                            tmp_particle%origin_z      = pos_z
+                            tmp_particle%radius        = particle_groups(i)%radius
+                            tmp_particle%weight_factor = initial_weighting_factor
+                            tmp_particle%class         = 1
+                            tmp_particle%group         = i
+                            tmp_particle%tailpoints    = 0     !unused
+                            tmp_particle%particle_mask = .TRUE.
+                            tmp_particle%tail_id       = 0     !unused
+
+!
+!--                         Determine the grid indices of the particle position
+                            ip = ( tmp_particle%x + 0.5_wp * dx ) * ddx
+                            jp = ( tmp_particle%y + 0.5_wp * dy ) * ddy
+                            kp = tmp_particle%z / dz + 1 + offset_ocean_nzt
+
+                            IF ( seed_follows_topography )  THEN
+!
+!--                            Particle height is given relative to topography
+                               kp = kp + nzb_w_inner(jp,ip)
+                               tmp_particle%z = tmp_particle%z + zw(kp)
+                               IF ( kp > nzt )  THEN
+                                  pos_x = pos_x + pdx(i)
+                                  CYCLE xloop
+                               ENDIF
+                            ENDIF
+
+                            local_count(kp,jp,ip) = local_count(kp,jp,ip) + 1
+                            IF ( .NOT. first_stride )  THEN
+                               IF ( ip < nxl  .OR.  jp < nys  .OR.  kp < nzb+1 )  THEN
+                                  write(6,*) 'xl ',ip,jp,kp,nxl,nys,nzb+1
+                               ENDIF
+                               IF ( ip > nxr  .OR.  jp > nyn  .OR.  kp > nzt )  THEN
+                                  write(6,*) 'xu ',ip,jp,kp,nxr,nyn,nzt
+                               ENDIF
+                               grid_particles(kp,jp,ip)%particles(local_count(kp,jp,ip)) = tmp_particle
+                            ENDIF
+                         ENDDO
+
+                      ENDIF
+
+                      pos_x = pos_x + pdx(i)
+
+                   ENDDO xloop
+
+                ENDIF
+
+                pos_y = pos_y + pdy(i)
+
+             ENDDO
+
+             pos_z = pos_z + pdz(i)
+
+          ENDDO
+
+       ENDDO
+
+       IF ( first_stride )  THEN
+          DO  ip = nxl, nxr
+             DO  jp = nys, nyn
+                DO  kp = nzb+1, nzt
+                   IF ( phase == PHASE_INIT )  THEN
+                      IF ( local_count(kp,jp,ip) > 0 )  THEN
+                         alloc_size = MAX( INT( local_count(kp,jp,ip) *        &
+                            ( 1.0_wp + alloc_factor / 100.0_wp ) ),            &
+                            min_nr_particle )
+                      ELSE
+                         alloc_size = min_nr_particle
+                      ENDIF
+                      ALLOCATE(grid_particles(kp,jp,ip)%particles(1:alloc_size))
+                      DO  n = 1, alloc_size
+                         grid_particles(kp,jp,ip)%particles(n) = zero_particle
+                      ENDDO
+                   ELSEIF ( phase == PHASE_RELEASE )  THEN
+                      IF ( local_count(kp,jp,ip) > 0 )  THEN
+                         new_size   = local_count(kp,jp,ip) + prt_count(kp,jp,ip)
+                         alloc_size = MAX( INT( new_size * ( 1.0_wp +          &
+                            alloc_factor / 100.0_wp ) ), min_nr_particle )
+                         IF( alloc_size > SIZE( grid_particles(kp,jp,ip)%particles) )  THEN
+                           CALL realloc_particles_array(ip,jp,kp,alloc_size)
+                         ENDIF
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDIF
+    ENDDO
+
+    local_start = prt_count+1
+    prt_count   = local_count
+
+!
+!-- Initialize aerosol background spectrum
+    IF ( curvature_solution_effects  .AND.  .NOT. monodisperse_aerosols )  THEN
+       CALL lpm_init_aerosols(local_start)
+    ENDIF
+
+!
+!-- Add random fluctuation to particle positions
+    IF ( random_start_position )  THEN
+       DO  ip = nxl, nxr
+          DO  jp = nys, nyn
+             DO  kp = nzb+1, nzt
+                number_of_particles = prt_count(kp,jp,ip)
+                IF ( number_of_particles <= 0 )  CYCLE
+                particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
+
+                DO  n = local_start(kp,jp,ip), number_of_particles              !Move only new particles
+                   IF ( psl(particles(n)%group) /= psr(particles(n)%group) )  THEN
+                      particles(n)%x = particles(n)%x +                        &
+                                   ( random_function( iran_part ) - 0.5_wp ) * &
+                                   pdx(particles(n)%group)
+                   ENDIF
+                   IF ( pss(particles(n)%group) /= psn(particles(n)%group) )  THEN
+                      particles(n)%y = particles(n)%y +                        &
+                                   ( random_function( iran_part ) - 0.5_wp ) * &
+                                   pdy(particles(n)%group)
+                   ENDIF
+                   IF ( psb(particles(n)%group) /= pst(particles(n)%group) )  THEN
+                      particles(n)%z = particles(n)%z +                        &
+                                   ( random_function( iran_part ) - 0.5_wp ) * &
+                                   pdz(particles(n)%group)
+                   ENDIF
+                ENDDO
+!
+!--             Identify particles located outside the model domain
+                CALL lpm_boundary_conds( 'bottom/top' )
+             ENDDO
+          ENDDO
+       ENDDO
+!
+!--    Exchange particles between grid cells and processors
+       CALL lpm_move_particle
+       CALL lpm_exchange_horiz
+
+    ENDIF
+!
+!-- In case of random_start_position, delete particles identified by 
+!-- lpm_exchange_horiz and lpm_boundary_conds. Then sort particles into blocks, 
+!-- which is needed for a fast interpolation of the LES fields on the particle 
+!-- position.
+    CALL lpm_pack_all_arrays
+
+!
+!-- Determine maximum number of particles (i.e., all possible particles that 
+!-- have been allocated) and the current number of particles
+    DO  ip = nxl, nxr
+       DO  jp = nys, nyn
+          DO  kp = nzb+1, nzt
+             maximum_number_of_particles = maximum_number_of_particles         &
+                                           + SIZE(grid_particles(kp,jp,ip)%particles)
+             number_of_particles         = number_of_particles                 &
+                                           + prt_count(kp,jp,ip)
+          ENDDO
+       ENDDO
+    ENDDO
+!
+!-- Calculate the number of particles of the total domain
+#if defined( __parallel )
+    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
+    CALL MPI_ALLREDUCE( number_of_particles, total_number_of_particles, 1, &
+    MPI_INTEGER, MPI_SUM, comm2d, ierr )
+#else
+    total_number_of_particles = number_of_particles
+#endif
+
+    RETURN
+
+ END SUBROUTINE lpm_create_particle
+
+ SUBROUTINE lpm_init_aerosols(local_start)
+
+    USE arrays_3d,                                                             &
+        ONLY: hyp, pt, q  
+
+    USE cloud_parameters,                                                      &
+        ONLY: l_d_rv, rho_l
+
+    USE constants,                                                             &
+        ONLY: pi
+
+    USE kinds
+
+    USE particle_attributes,                                                   &
+        ONLY: init_aerosol_probabilistic, molecular_weight_of_solute,          &
+              molecular_weight_of_water, n1, n2, n3, rho_s, rm1, rm2, rm3,     &
+              s1, s2, s3, vanthoff
+
+    IMPLICIT NONE
+
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cdf     !< CDF of aerosol spectrum 
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_temp  !< dry aerosol radius spectrum
+
+    REAL(wp)  :: bfactor            !< solute effects
+    REAL(wp)  :: dr                 !< width of radius bin
+    REAL(wp)  :: e_a                !< vapor pressure
+    REAL(wp)  :: e_s                !< saturation vapor pressure
+    REAL(wp)  :: n_init             !< sum of all aerosol concentrations
+    REAL(wp)  :: pdf                !< PDF of aerosol spectrum
+    REAL(wp)  :: rmin = 1.0e-8_wp   !< minimum aerosol radius
+    REAL(wp)  :: rmax = 1.0e-6_wp   !< maximum aerosol radius
+    REAL(wp)  :: rs_rand            !< random number
+    REAL(wp)  :: r_mid              !< mean radius
+    REAL(wp)  :: t_int              !< temperature
+    REAL(wp)  :: weight_sum         !< sum of all weighting factors
+
+    INTEGER(iwp), DIMENSION(:,:,:), INTENT(IN) ::  local_start !<
+
+    INTEGER(iwp)  :: n              !<
+    INTEGER(iwp)  :: nn             !<
+    INTEGER(iwp)  :: no_bins = 999  !< number of bins
+    INTEGER(iwp)  :: ip             !<
+    INTEGER(iwp)  :: jp             !<
+    INTEGER(iwp)  :: kp             !<
+
+    LOGICAL ::  new_pdf = .FALSE.   !< check if aerosol PDF has to be recalculated
+
+!
+!-- Compute aerosol background distribution
+    IF ( init_aerosol_probabilistic )  THEN
+       ALLOCATE( cdf(0:no_bins), r_temp(0:no_bins) )
+       DO n = 0, no_bins
+          r_temp(n) = EXP( LOG(rmin) + ( LOG(rmax) - LOG(rmin ) ) /            &
+                           REAL(no_bins, KIND=wp) * REAL(n, KIND=wp) )
+
+          cdf(n) = 0.0_wp
+          n_init = n1 + n2 + n3
+          IF ( n1 > 0.0_wp )  THEN 
+             cdf(n) = cdf(n) + n1 / n_init * ( 0.5_wp + 0.5_wp *        &
+                                  ERF( LOG( r_temp(n) / rm1 ) /         &
+                                       ( SQRT(2.0_wp) * LOG(s1) )       &
+                                     ) )
+          ENDIF
+          IF ( n2 > 0.0_wp )  THEN 
+             cdf(n) = cdf(n) + n2 / n_init * ( 0.5_wp + 0.5_wp *        &
+                                  ERF( LOG( r_temp(n) / rm2 ) /         &
+                                       ( SQRT(2.0_wp) * LOG(s2) )       &
+                                     ) )
+          ENDIF
+          IF ( n3 > 0.0_wp )  THEN 
+             cdf(n) = cdf(n) + n3 / n_init * ( 0.5_wp + 0.5_wp *        &
+                                  ERF( LOG( r_temp(n) / rm3 ) /         &
+                                       ( SQRT(2.0_wp) * LOG(s3) )       &
+                                     ) )
+          ENDIF
+
+       ENDDO
+    ENDIF
+
+    DO  ip = nxl, nxr
+       DO  jp = nys, nyn
+          DO  kp = nzb+1, nzt
+
+             number_of_particles = prt_count(kp,jp,ip)
+             IF ( number_of_particles <= 0 )  CYCLE
+             particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
+!
+!--          Initialize the aerosols with a predefined spectral distribution
+!--          of the dry radius (logarithmically increasing bins) and a varying 
+!--          weighting factor
+             IF ( .NOT. init_aerosol_probabilistic )  THEN
+
+                new_pdf = .FALSE.
+                IF ( .NOT. ALLOCATED( r_temp ) )  THEN
+                   new_pdf = .TRUE.
+                ELSE
+                   IF ( SIZE( r_temp ) .NE. &
+                        number_of_particles - local_start(kp,jp,ip) + 2 )  THEN
+                      new_pdf = .TRUE.
+                      DEALLOCATE( r_temp )
+                   ENDIF
+                ENDIF
+
+                IF ( new_pdf )  THEN
+
+                   no_bins = number_of_particles + 1 - local_start(kp,jp,ip)
+                   ALLOCATE( r_temp(0:no_bins) )
+
+                   DO n = 0, no_bins
+                      r_temp(n) = EXP( LOG(rmin) + ( LOG(rmax) - LOG(rmin ) ) / &
+                                       REAL(no_bins, KIND=wp) *                 &
+                                       REAL(n, KIND=wp) )
+                   ENDDO
+
+                ENDIF
+
+!
+!--             Calculate radius and concentration of each aerosol
+                DO n = local_start(kp,jp,ip), number_of_particles
+
+                   nn = n - local_start(kp,jp,ip)
+
+                   r_mid = SQRT( r_temp(nn) * r_temp(nn+1) )
+                   dr    = r_temp(nn+1) - r_temp(nn)
+
+                   pdf    = 0.0_wp
+                   n_init = n1 + n2 + n3
+                   IF ( n1 > 0.0_wp )  THEN 
+                      pdf = pdf + n1 / n_init * ( 1.0_wp / ( r_mid * LOG(s1) *      &
+                                                             SQRT( 2.0_wp * pi )    &
+                                                           ) *                      &
+                                                  EXP( -( LOG( r_mid / rm1 ) )**2 / &
+                                                       ( 2.0_wp * LOG(s1)**2 )      &
+                                                     )                              &
+                                                )
+                   ENDIF
+                   IF ( n2 > 0.0_wp )  THEN
+                      pdf = pdf + n2 / n_init * ( 1.0_wp / ( r_mid * LOG(s2) *      &
+                                                             SQRT( 2.0_wp * pi )    &
+                                                           ) *                      &
+                                                  EXP( -( LOG( r_mid / rm2 ) )**2 / &
+                                                       ( 2.0_wp * LOG(s2)**2 )      &
+                                                     )                              &
+                                                )
+                   ENDIF
+                   IF ( n3 > 0.0_wp )  THEN
+                      pdf = pdf + n3 / n_init * ( 1.0_wp / ( r_mid * LOG(s3) *      &
+                                                             SQRT( 2.0_wp * pi )    &
+                                                           ) *                      &
+                                                  EXP( -( LOG( r_mid / rm3 ) )**2 / &
+                                                       ( 2.0_wp * LOG(s3)**2 )      &
+                                                     )                              &
+                                                )
+                   ENDIF
+
+                   particles(n)%rvar2         = r_mid
+                   particles(n)%weight_factor = pdf * dr
+
+                END DO
+!
+!--             Adjust weighting factors to initialize the same number of aerosols
+!--             in every grid box
+                weight_sum = SUM(particles(local_start(kp,jp,ip):number_of_particles)%weight_factor)
+
+                particles(local_start(kp,jp,ip):number_of_particles)%weight_factor =     &
+                   particles(local_start(kp,jp,ip):number_of_particles)%weight_factor /  &
+                   weight_sum * initial_weighting_factor * ( no_bins + 1 )
+
+             ENDIF
+!
+!--          Initialize the aerosols with a predefined weighting factor but 
+!--          a randomly choosen dry radius
+             IF ( init_aerosol_probabilistic )  THEN
+
+                DO  n = local_start(kp,jp,ip), number_of_particles  !only new particles 
+
+                   rs_rand = -1.0_wp
+                   DO WHILE ( rs_rand .LT. cdf(0)  .OR.  rs_rand .GE. cdf(no_bins)  )
+                      rs_rand = random_function( iran_part )
+                   ENDDO
+!
+!--                Determine aerosol dry radius by a random number generator
+                   DO nn = 0, no_bins-1
+                      IF ( cdf(nn) .LE. rs_rand  .AND.  cdf(nn+1) .GT. rs_rand )  THEN
+                         particles(n)%rvar2 = r_temp(nn) + ( r_temp(nn+1) - r_temp(nn) ) / &
+                                              ( cdf(nn+1) - cdf(nn) ) * ( rs_rand - cdf(nn) )
+                         EXIT
+                      ENDIF
+                   ENDDO
+
+                ENDDO
+
+             ENDIF
+
+!
+!--          Set particle radius to equilibrium radius based on the environmental
+!--          supersaturation (Khvorostyanov and Curry, 2007, JGR). This avoids
+!--          the sometimes lengthy growth toward their equilibrium radius within 
+!--          the simulation.
+             t_int  = pt(kp,jp,ip) * ( hyp(kp) / 100000.0_wp )**0.286_wp
+
+             e_s = 611.0_wp * EXP( l_d_rv * ( 3.6609E-3_wp - 1.0_wp / t_int ) )
+             e_a = q(kp,jp,ip) * hyp(kp) / ( 0.378_wp * q(kp,jp,ip) + 0.622_wp )
+
+!
+!--          The formula is only valid for subsaturated environments. In (super-)
+!--          saturated air, the inital radius is used.
+             IF ( e_a / e_s < 1.0_wp )  THEN
+
+                DO  n = local_start(kp,jp,ip), number_of_particles  !only new particles 
+
+                   bfactor             = vanthoff * molecular_weight_of_water *    &
+                                         rho_s * particles(n)%rvar2**3 /           &
+                                         ( molecular_weight_of_solute * rho_l )
+                   particles(n)%radius = particles(n)%rvar2 * ( bfactor /          &
+                                         particles(n)%rvar2**3 )**(1.0_wp/3.0_wp) *&
+                                         ( 1.0_wp - e_a / e_s )**(-1.0_wp/3.0_wp)
+
+                ENDDO
+
+             ENDIF
+
+          ENDDO
+       ENDDO
+    ENDDO
+!
+!-- Deallocate used arrays
+    IF ( ALLOCATED(r_temp) )  DEALLOCATE( r_temp )
+    IF ( ALLOCATED(cdf) )     DEALLOCATE( cdf )
+
+ END SUBROUTINE lpm_init_aerosols
+
+END MODULE lpm_init_mod
Index: lm/trunk/SOURCE/lpm_init_mod.f90
===================================================================
--- /palm/trunk/SOURCE/lpm_init_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,1005 +1,0 @@
-!> @file lpm_init_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1871 2016-04-15 11:46:09Z hoffmann
-! Initialization of aerosols added.
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-!
-! 1831 2016-04-07 13:15:51Z hoffmann
-! curvature_solution_effects moved to particle_attributes
-!
-! 1822 2016-04-07 07:49:42Z hoffmann
-! Unused variables removed.
-!
-! 1783 2016-03-06 18:36:17Z raasch
-! netcdf module added
-!
-! 1725 2015-11-17 13:01:51Z hoffmann 
-! Bugfix: Processor-dependent seed for random function is generated before it is 
-! used.
-!
-! 1691 2015-10-26 16:17:44Z maronga
-! Renamed prandtl_layer to constant_flux_layer.
-!
-! 1685 2015-10-08 07:32:13Z raasch
-! bugfix concerning vertical index offset in case of ocean
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-!
-! 1575 2015-03-27 09:56:27Z raasch
-! initial vertical particle position is allowed to follow the topography
-!
-! 1359 2014-04-11 17:15:14Z hoffmann
-! New particle structure integrated. 
-! Kind definition added to all floating point numbers.
-! lpm_init changed form a subroutine to a module.
-! 
-! 1327 2014-03-21 11:00:16Z raasch
-! -netcdf_output
-!
-! 1322 2014-03-20 16:38:49Z raasch
-! REAL functions provided with KIND-attribute
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-! bugfix: #if defined( __parallel ) added
-!
-! 1314 2014-03-14 18:25:17Z suehring
-! Vertical logarithmic interpolation of horizontal particle speed for particles 
-! between roughness height and first vertical grid level.
-!
-! 1092 2013-02-02 11:24:22Z raasch
-! unused variables removed
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 849 2012-03-15 10:35:09Z raasch
-! routine renamed: init_particles -> lpm_init
-! de_dx, de_dy, de_dz are allocated here (instead of automatic arrays in
-! advec_particles),
-! sort_particles renamed lpm_sort_arrays, user_init_particles renamed lpm_init
-!
-! 828 2012-02-21 12:00:36Z raasch
-! call of init_kernels, particle feature color renamed class
-!
-! 824 2012-02-17 09:09:57Z raasch
-! particle attributes speed_x|y|z_sgs renamed rvar1|2|3,
-! array particles implemented as pointer
-!
-! 667 2010-12-23 12:06:00Z suehring/gryschka
-! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng for allocation 
-! of arrays.
-!
-! Revision 1.1  1999/11/25 16:22:38  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> This routine initializes a set of particles and their attributes (position,
-!> radius, ..) which are used by the Lagrangian particle model (see lpm).
-!------------------------------------------------------------------------------!
- MODULE lpm_init_mod
- 
-
-    USE arrays_3d,                                                             &
-        ONLY:  de_dx, de_dy, de_dz, zu, zw, z0
-
-    USE control_parameters,                                                    &
-        ONLY:  cloud_droplets, constant_flux_layer, current_timestep_number,   &
-               dz, initializing_actions, message_string, ocean, simulated_time
-
-    USE grid_variables,                                                        &
-        ONLY:  ddx, dx, ddy, dy
-
-    USE indices,                                                               &
-        ONLY:  nx, nxl, nxlg, nxrg, nxr, ny, nyn, nys, nyng, nysg, nz, nzb,    &
-               nzb_w_inner, nzt
-
-    USE kinds
-
-    USE lpm_collision_kernels_mod,                                             &
-        ONLY:  init_kernels
-
-    USE netcdf_interface,                                                      &
-        ONLY:  netcdf_data_format
-
-    USE particle_attributes,                                                   &
-        ONLY:   alloc_factor, bc_par_b, bc_par_lr, bc_par_ns, bc_par_t,        &
-                block_offset, block_offset_def, collision_kernel,              &
-                curvature_solution_effects,                                    &
-                density_ratio, grid_particles,                                 &
-                initial_weighting_factor, ibc_par_b, ibc_par_lr, ibc_par_ns,   &
-                ibc_par_t, iran_part, log_z_z0,                                &
-                max_number_of_particle_groups, maximum_number_of_particles,    &
-                min_nr_particle, mpi_particle_type,                            &
-                number_of_particles,                                           &
-                number_of_particle_groups, number_of_sublayers,                &
-                offset_ocean_nzt, offset_ocean_nzt_m1,                         &
-                particles, particle_advection_start, particle_groups,          &
-                particle_groups_type, particles_per_point,                     &
-                particle_type, pdx, pdy, pdz,                                  &
-                prt_count, psb, psl, psn, psr, pss, pst,                       &
-                radius, random_start_position, read_particles_from_restartfile,&
-                seed_follows_topography, sort_count,                           &
-                total_number_of_particles,                                     &
-                use_sgs_for_particles,                                         &
-                write_particle_statistics, uniform_particles, zero_particle,   &
-                z0_av_global
-
-    USE pegrid
-
-    USE random_function_mod,                                                   &
-        ONLY:  random_function
-
-    IMPLICIT NONE
-
-    PRIVATE
-
-    INTEGER(iwp), PARAMETER         :: PHASE_INIT    = 1  !<
-    INTEGER(iwp), PARAMETER, PUBLIC :: PHASE_RELEASE = 2  !<
-
-    INTERFACE lpm_init
-       MODULE PROCEDURE lpm_init
-    END INTERFACE lpm_init
-
-    INTERFACE lpm_create_particle
-       MODULE PROCEDURE lpm_create_particle
-    END INTERFACE lpm_create_particle
-
-    PUBLIC lpm_init, lpm_create_particle
-
-CONTAINS
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!------------------------------------------------------------------------------!
- SUBROUTINE lpm_init
-
-    USE lpm_collision_kernels_mod,                                             &
-        ONLY:  init_kernels
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i                           !<
-    INTEGER(iwp) ::  j                           !<
-    INTEGER(iwp) ::  k                           !<
-
-#if defined( __parallel )
-    INTEGER(iwp), DIMENSION(3) ::  blocklengths  !<
-    INTEGER(iwp), DIMENSION(3) ::  displacements !<
-    INTEGER(iwp), DIMENSION(3) ::  types         !<
-#endif
-
-    REAL(wp) ::  height_int                      !<
-    REAL(wp) ::  height_p                        !<
-    REAL(wp) ::  z_p                             !<
-    REAL(wp) ::  z0_av_local                     !<
-
-#if defined( __parallel )
-!
-!-- Define MPI derived datatype for FORTRAN datatype particle_type (see module
-!-- particle_attributes). Integer length is 4 byte, Real is 8 byte
-    blocklengths(1)  = 19;  blocklengths(2)  =   6;  blocklengths(3)  =   1
-    displacements(1) =  0;  displacements(2) = 152;  displacements(3) = 176
-
-    types(1) = MPI_REAL
-    types(2) = MPI_INTEGER
-    types(3) = MPI_UB
-    CALL MPI_TYPE_STRUCT( 3, blocklengths, displacements, types, &
-                          mpi_particle_type, ierr )
-    CALL MPI_TYPE_COMMIT( mpi_particle_type, ierr )
-#endif
-
-!
-!-- In case of oceans runs, the vertical index calculations need an offset,
-!-- because otherwise the k indices will become negative
-    IF ( ocean )  THEN
-       offset_ocean_nzt    = nzt
-       offset_ocean_nzt_m1 = nzt - 1
-    ENDIF
-
-!
-!-- Define block offsets for dividing a gridcell in 8 sub cells
-
-    block_offset(0) = block_offset_def (-1,-1,-1)
-    block_offset(1) = block_offset_def (-1,-1, 0)
-    block_offset(2) = block_offset_def (-1, 0,-1)
-    block_offset(3) = block_offset_def (-1, 0, 0)
-    block_offset(4) = block_offset_def ( 0,-1,-1)
-    block_offset(5) = block_offset_def ( 0,-1, 0)
-    block_offset(6) = block_offset_def ( 0, 0,-1)
-    block_offset(7) = block_offset_def ( 0, 0, 0)
-!
-!-- Check the number of particle groups.
-    IF ( number_of_particle_groups > max_number_of_particle_groups )  THEN
-       WRITE( message_string, * ) 'max_number_of_particle_groups =',      &
-                                  max_number_of_particle_groups ,         &
-                                  '&number_of_particle_groups reset to ', &
-                                  max_number_of_particle_groups
-       CALL message( 'lpm_init', 'PA0213', 0, 1, 0, 6, 0 )
-       number_of_particle_groups = max_number_of_particle_groups
-    ENDIF
-
-!
-!-- Set default start positions, if necessary
-    IF ( psl(1) == 9999999.9_wp )  psl(1) = -0.5_wp * dx
-    IF ( psr(1) == 9999999.9_wp )  psr(1) = ( nx + 0.5_wp ) * dx
-    IF ( pss(1) == 9999999.9_wp )  pss(1) = -0.5_wp * dy
-    IF ( psn(1) == 9999999.9_wp )  psn(1) = ( ny + 0.5_wp ) * dy
-    IF ( psb(1) == 9999999.9_wp )  psb(1) = zu(nz/2)
-    IF ( pst(1) == 9999999.9_wp )  pst(1) = psb(1)
-
-    IF ( pdx(1) == 9999999.9_wp  .OR.  pdx(1) == 0.0_wp )  pdx(1) = dx
-    IF ( pdy(1) == 9999999.9_wp  .OR.  pdy(1) == 0.0_wp )  pdy(1) = dy
-    IF ( pdz(1) == 9999999.9_wp  .OR.  pdz(1) == 0.0_wp )  pdz(1) = zu(2) - zu(1)
-
-    DO  j = 2, number_of_particle_groups
-       IF ( psl(j) == 9999999.9_wp )  psl(j) = psl(j-1)
-       IF ( psr(j) == 9999999.9_wp )  psr(j) = psr(j-1)
-       IF ( pss(j) == 9999999.9_wp )  pss(j) = pss(j-1)
-       IF ( psn(j) == 9999999.9_wp )  psn(j) = psn(j-1)
-       IF ( psb(j) == 9999999.9_wp )  psb(j) = psb(j-1)
-       IF ( pst(j) == 9999999.9_wp )  pst(j) = pst(j-1)
-       IF ( pdx(j) == 9999999.9_wp  .OR.  pdx(j) == 0.0_wp )  pdx(j) = pdx(j-1)
-       IF ( pdy(j) == 9999999.9_wp  .OR.  pdy(j) == 0.0_wp )  pdy(j) = pdy(j-1)
-       IF ( pdz(j) == 9999999.9_wp  .OR.  pdz(j) == 0.0_wp )  pdz(j) = pdz(j-1)
-    ENDDO
-
-!
-!-- Allocate arrays required for calculating particle SGS velocities
-    IF ( use_sgs_for_particles  .AND.  .NOT. cloud_droplets )  THEN
-       ALLOCATE( de_dx(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
-                 de_dy(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
-                 de_dz(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ENDIF
-
-!
-!-- Allocate array required for logarithmic vertical interpolation of 
-!-- horizontal particle velocities between the surface and the first vertical
-!-- grid level. In order to avoid repeated CPU cost-intensive CALLS of 
-!-- intrinsic FORTRAN procedure LOG(z/z0), LOG(z/z0) is precalculated for 
-!-- several heights. Splitting into 20 sublayers turned out to be sufficient. 
-!-- To obtain exact height levels of particles, linear interpolation is applied
-!-- (see lpm_advec.f90).
-    IF ( constant_flux_layer )  THEN
-       
-       ALLOCATE ( log_z_z0(0:number_of_sublayers) ) 
-       z_p         = zu(nzb+1) - zw(nzb)
-
-!
-!--    Calculate horizontal mean value of z0 used for logartihmic
-!--    interpolation. Note: this is not exact for heterogeneous z0. 
-!--    However, sensitivity studies showed that the effect is 
-!--    negligible. 
-       z0_av_local  = SUM( z0(nys:nyn,nxl:nxr) )
-       z0_av_global = 0.0_wp
-
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE(z0_av_local, z0_av_global, 1, MPI_REAL, MPI_SUM, &
-                          comm2d, ierr )
-#else
-       z0_av_global = z0_av_local
-#endif
-
-       z0_av_global = z0_av_global  / ( ( ny + 1 ) * ( nx + 1 ) )
-!
-!--    Horizontal wind speed is zero below and at z0
-       log_z_z0(0) = 0.0_wp
-!
-!--    Calculate vertical depth of the sublayers
-       height_int  = ( z_p - z0_av_global ) / REAL( number_of_sublayers, KIND=wp )
-!
-!--    Precalculate LOG(z/z0)
-       height_p    = 0.0_wp
-       DO  k = 1, number_of_sublayers
-
-          height_p    = height_p + height_int
-          log_z_z0(k) = LOG( height_p / z0_av_global )
-
-       ENDDO
-
-
-    ENDIF
-
-!
-!-- Check boundary condition and set internal variables
-    SELECT CASE ( bc_par_b )
-    
-       CASE ( 'absorb' )
-          ibc_par_b = 1
-
-       CASE ( 'reflect' )
-          ibc_par_b = 2
-          
-       CASE DEFAULT
-          WRITE( message_string, * )  'unknown boundary condition ',   &
-                                       'bc_par_b = "', TRIM( bc_par_b ), '"'
-          CALL message( 'lpm_init', 'PA0217', 1, 2, 0, 6, 0 )
-          
-    END SELECT
-    SELECT CASE ( bc_par_t )
-    
-       CASE ( 'absorb' )
-          ibc_par_t = 1
-
-       CASE ( 'reflect' )
-          ibc_par_t = 2
-          
-       CASE DEFAULT
-          WRITE( message_string, * ) 'unknown boundary condition ',   &
-                                     'bc_par_t = "', TRIM( bc_par_t ), '"'
-          CALL message( 'lpm_init', 'PA0218', 1, 2, 0, 6, 0 )
-          
-    END SELECT
-    SELECT CASE ( bc_par_lr )
-
-       CASE ( 'cyclic' )
-          ibc_par_lr = 0
-
-       CASE ( 'absorb' )
-          ibc_par_lr = 1
-
-       CASE ( 'reflect' )
-          ibc_par_lr = 2
-          
-       CASE DEFAULT
-          WRITE( message_string, * ) 'unknown boundary condition ',   &
-                                     'bc_par_lr = "', TRIM( bc_par_lr ), '"'
-          CALL message( 'lpm_init', 'PA0219', 1, 2, 0, 6, 0 )
-          
-    END SELECT
-    SELECT CASE ( bc_par_ns )
-
-       CASE ( 'cyclic' )
-          ibc_par_ns = 0
-
-       CASE ( 'absorb' )
-          ibc_par_ns = 1
-
-       CASE ( 'reflect' )
-          ibc_par_ns = 2
-          
-       CASE DEFAULT
-          WRITE( message_string, * ) 'unknown boundary condition ',   &
-                                     'bc_par_ns = "', TRIM( bc_par_ns ), '"'
-          CALL message( 'lpm_init', 'PA0220', 1, 2, 0, 6, 0 )
-          
-    END SELECT
-
-!
-!-- Initialize collision kernels
-    IF ( collision_kernel /= 'none' )  CALL init_kernels
-
-!
-!-- For the first model run of a possible job chain initialize the
-!-- particles, otherwise read the particle data from restart file.
-    IF ( TRIM( initializing_actions ) == 'read_restart_data'  &
-         .AND.  read_particles_from_restartfile )  THEN
-
-       CALL lpm_read_restart_file
-
-    ELSE
-
-!
-!--    Allocate particle arrays and set attributes of the initial set of
-!--    particles, which can be also periodically released at later times.
-       ALLOCATE( prt_count(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
-                 grid_particles(nzb+1:nzt,nys:nyn,nxl:nxr) )
-
-       maximum_number_of_particles = 0
-       number_of_particles         = 0
-
-       sort_count = 0
-       prt_count  = 0
-
-!
-!--    Initialize all particles with dummy values (otherwise errors may
-!--    occur within restart runs). The reason for this is still not clear
-!--    and may be presumably caused by errors in the respective user-interface.
-       zero_particle = particle_type( 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp,  &
-                                      0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp,  &
-                                      0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp,  &
-                                      0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0, 0, 0, &
-                                      0, .FALSE., -1)
-
-       particle_groups = particle_groups_type( 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
-
-!
-!--    Set values for the density ratio and radius for all particle
-!--    groups, if necessary
-       IF ( density_ratio(1) == 9999999.9_wp )  density_ratio(1) = 0.0_wp
-       IF ( radius(1)        == 9999999.9_wp )  radius(1) = 0.0_wp
-       DO  i = 2, number_of_particle_groups
-          IF ( density_ratio(i) == 9999999.9_wp )  THEN
-             density_ratio(i) = density_ratio(i-1)
-          ENDIF
-          IF ( radius(i) == 9999999.9_wp )  radius(i) = radius(i-1)
-       ENDDO
-
-       DO  i = 1, number_of_particle_groups
-          IF ( density_ratio(i) /= 0.0_wp  .AND.  radius(i) == 0 )  THEN
-             WRITE( message_string, * ) 'particle group #', i, 'has a', &
-                                        'density ratio /= 0 but radius = 0'
-             CALL message( 'lpm_init', 'PA0215', 1, 2, 0, 6, 0 )
-          ENDIF
-          particle_groups(i)%density_ratio = density_ratio(i)
-          particle_groups(i)%radius        = radius(i)
-       ENDDO
-
-!
-!--    Set a seed value for the random number generator to be exclusively
-!--    used for the particle code. The generated random numbers should be
-!--    different on the different PEs.
-       iran_part = iran_part + myid
-
-       CALL lpm_create_particle (PHASE_INIT)
-
-!
-!--    User modification of initial particles
-       CALL user_lpm_init
-
-!
-!--    Open file for statistical informations about particle conditions
-       IF ( write_particle_statistics )  THEN
-          CALL check_open( 80 )
-          WRITE ( 80, 8000 )  current_timestep_number, simulated_time,         &
-                              number_of_particles,                             &
-                              maximum_number_of_particles
-          CALL close_file( 80 )
-       ENDIF
-
-    ENDIF
-
-!
-!-- To avoid programm abort, assign particles array to the local version of 
-!-- first grid cell
-    number_of_particles = prt_count(nzb+1,nys,nxl)
-    particles => grid_particles(nzb+1,nys,nxl)%particles(1:number_of_particles)
-
-!
-!-- Formats
-8000 FORMAT (I6,1X,F7.2,4X,I10,71X,I10)
-
- END SUBROUTINE lpm_init
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!------------------------------------------------------------------------------!
- SUBROUTINE lpm_create_particle (phase)
-
-    USE lpm_exchange_horiz_mod,                                                &
-        ONLY: lpm_exchange_horiz, lpm_move_particle, realloc_particles_array
-
-    USE lpm_pack_arrays_mod,                                                   &
-        ONLY: lpm_pack_all_arrays
-
-    USE particle_attributes,                                                   &
-        ONLY: monodisperse_aerosols
-
-    IMPLICIT  NONE
-
-    INTEGER(iwp)               ::  alloc_size  !<
-    INTEGER(iwp)               ::  i           !<
-    INTEGER(iwp)               ::  ip          !<
-    INTEGER(iwp)               ::  j           !<
-    INTEGER(iwp)               ::  jp          !<
-    INTEGER(iwp)               ::  kp          !<
-    INTEGER(iwp)               ::  loop_stride !<
-    INTEGER(iwp)               ::  n           !<
-    INTEGER(iwp)               ::  new_size    !<
-
-    INTEGER(iwp), INTENT(IN)   ::  phase       !<
-
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  local_count !<
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  local_start !<
-
-    LOGICAL                    ::  first_stride !<
-
-    REAL(wp)                   ::  pos_x !<
-    REAL(wp)                   ::  pos_y !<
-    REAL(wp)                   ::  pos_z !<
-
-    TYPE(particle_type),TARGET ::  tmp_particle !<
-
-!
-!-- Calculate particle positions and store particle attributes, if
-!-- particle is situated on this PE
-    DO  loop_stride = 1, 2
-       first_stride = (loop_stride == 1)
-       IF ( first_stride )   THEN
-          local_count = 0           ! count number of particles
-       ELSE
-          local_count = prt_count   ! Start address of new particles
-       ENDIF
-
-       n = 0
-       DO  i = 1, number_of_particle_groups
-
-          pos_z = psb(i)
-
-          DO WHILE ( pos_z <= pst(i) )
-
-             pos_y = pss(i)
-
-             DO WHILE ( pos_y <= psn(i) )
-
-                IF ( pos_y >= ( nys - 0.5_wp ) * dy  .AND.  &
-                     pos_y <  ( nyn + 0.5_wp ) * dy )  THEN
-
-                   pos_x = psl(i)
-
-            xloop: DO WHILE ( pos_x <= psr(i) )
-
-                      IF ( pos_x >= ( nxl - 0.5_wp ) * dx  .AND.  &
-                           pos_x <  ( nxr + 0.5_wp ) * dx )  THEN
-
-                         DO  j = 1, particles_per_point
-
-                            n = n + 1
-                            tmp_particle%x             = pos_x
-                            tmp_particle%y             = pos_y
-                            tmp_particle%z             = pos_z
-                            tmp_particle%age           = 0.0_wp
-                            tmp_particle%age_m         = 0.0_wp
-                            tmp_particle%dt_sum        = 0.0_wp
-                            tmp_particle%dvrp_psize    = 0.0_wp !unused
-                            tmp_particle%e_m           = 0.0_wp
-                            IF ( curvature_solution_effects )  THEN
-!
-!--                            Initial values (internal timesteps, derivative)
-!--                            for Rosenbrock method
-                               tmp_particle%rvar1      = 1.0E-6_wp     !last Rosenbrock timestep
-                               tmp_particle%rvar2      = 0.1E-6_wp     !dry aerosol radius
-                               tmp_particle%rvar3      = -9999999.9_wp !unused
-                            ELSE
-!
-!--                            Initial values for SGS velocities
-                               tmp_particle%rvar1      = 0.0_wp
-                               tmp_particle%rvar2      = 0.0_wp
-                               tmp_particle%rvar3      = 0.0_wp
-                            ENDIF
-                            tmp_particle%speed_x       = 0.0_wp
-                            tmp_particle%speed_y       = 0.0_wp
-                            tmp_particle%speed_z       = 0.0_wp
-                            tmp_particle%origin_x      = pos_x
-                            tmp_particle%origin_y      = pos_y
-                            tmp_particle%origin_z      = pos_z
-                            tmp_particle%radius        = particle_groups(i)%radius
-                            tmp_particle%weight_factor = initial_weighting_factor
-                            tmp_particle%class         = 1
-                            tmp_particle%group         = i
-                            tmp_particle%tailpoints    = 0     !unused
-                            tmp_particle%particle_mask = .TRUE.
-                            tmp_particle%tail_id       = 0     !unused
-
-!
-!--                         Determine the grid indices of the particle position
-                            ip = ( tmp_particle%x + 0.5_wp * dx ) * ddx
-                            jp = ( tmp_particle%y + 0.5_wp * dy ) * ddy
-                            kp = tmp_particle%z / dz + 1 + offset_ocean_nzt
-
-                            IF ( seed_follows_topography )  THEN
-!
-!--                            Particle height is given relative to topography
-                               kp = kp + nzb_w_inner(jp,ip)
-                               tmp_particle%z = tmp_particle%z + zw(kp)
-                               IF ( kp > nzt )  THEN
-                                  pos_x = pos_x + pdx(i)
-                                  CYCLE xloop
-                               ENDIF
-                            ENDIF
-
-                            local_count(kp,jp,ip) = local_count(kp,jp,ip) + 1
-                            IF ( .NOT. first_stride )  THEN
-                               IF ( ip < nxl  .OR.  jp < nys  .OR.  kp < nzb+1 )  THEN
-                                  write(6,*) 'xl ',ip,jp,kp,nxl,nys,nzb+1
-                               ENDIF
-                               IF ( ip > nxr  .OR.  jp > nyn  .OR.  kp > nzt )  THEN
-                                  write(6,*) 'xu ',ip,jp,kp,nxr,nyn,nzt
-                               ENDIF
-                               grid_particles(kp,jp,ip)%particles(local_count(kp,jp,ip)) = tmp_particle
-                            ENDIF
-                         ENDDO
-
-                      ENDIF
-
-                      pos_x = pos_x + pdx(i)
-
-                   ENDDO xloop
-
-                ENDIF
-
-                pos_y = pos_y + pdy(i)
-
-             ENDDO
-
-             pos_z = pos_z + pdz(i)
-
-          ENDDO
-
-       ENDDO
-
-       IF ( first_stride )  THEN
-          DO  ip = nxl, nxr
-             DO  jp = nys, nyn
-                DO  kp = nzb+1, nzt
-                   IF ( phase == PHASE_INIT )  THEN
-                      IF ( local_count(kp,jp,ip) > 0 )  THEN
-                         alloc_size = MAX( INT( local_count(kp,jp,ip) *        &
-                            ( 1.0_wp + alloc_factor / 100.0_wp ) ),            &
-                            min_nr_particle )
-                      ELSE
-                         alloc_size = min_nr_particle
-                      ENDIF
-                      ALLOCATE(grid_particles(kp,jp,ip)%particles(1:alloc_size))
-                      DO  n = 1, alloc_size
-                         grid_particles(kp,jp,ip)%particles(n) = zero_particle
-                      ENDDO
-                   ELSEIF ( phase == PHASE_RELEASE )  THEN
-                      IF ( local_count(kp,jp,ip) > 0 )  THEN
-                         new_size   = local_count(kp,jp,ip) + prt_count(kp,jp,ip)
-                         alloc_size = MAX( INT( new_size * ( 1.0_wp +          &
-                            alloc_factor / 100.0_wp ) ), min_nr_particle )
-                         IF( alloc_size > SIZE( grid_particles(kp,jp,ip)%particles) )  THEN
-                           CALL realloc_particles_array(ip,jp,kp,alloc_size)
-                         ENDIF
-                      ENDIF
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDDO
-
-    local_start = prt_count+1
-    prt_count   = local_count
-
-!
-!-- Initialize aerosol background spectrum
-    IF ( curvature_solution_effects  .AND.  .NOT. monodisperse_aerosols )  THEN
-       CALL lpm_init_aerosols(local_start)
-    ENDIF
-
-!
-!-- Add random fluctuation to particle positions
-    IF ( random_start_position )  THEN
-       DO  ip = nxl, nxr
-          DO  jp = nys, nyn
-             DO  kp = nzb+1, nzt
-                number_of_particles = prt_count(kp,jp,ip)
-                IF ( number_of_particles <= 0 )  CYCLE
-                particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
-
-                DO  n = local_start(kp,jp,ip), number_of_particles              !Move only new particles
-                   IF ( psl(particles(n)%group) /= psr(particles(n)%group) )  THEN
-                      particles(n)%x = particles(n)%x +                        &
-                                   ( random_function( iran_part ) - 0.5_wp ) * &
-                                   pdx(particles(n)%group)
-                   ENDIF
-                   IF ( pss(particles(n)%group) /= psn(particles(n)%group) )  THEN
-                      particles(n)%y = particles(n)%y +                        &
-                                   ( random_function( iran_part ) - 0.5_wp ) * &
-                                   pdy(particles(n)%group)
-                   ENDIF
-                   IF ( psb(particles(n)%group) /= pst(particles(n)%group) )  THEN
-                      particles(n)%z = particles(n)%z +                        &
-                                   ( random_function( iran_part ) - 0.5_wp ) * &
-                                   pdz(particles(n)%group)
-                   ENDIF
-                ENDDO
-!
-!--             Identify particles located outside the model domain
-                CALL lpm_boundary_conds( 'bottom/top' )
-             ENDDO
-          ENDDO
-       ENDDO
-!
-!--    Exchange particles between grid cells and processors
-       CALL lpm_move_particle
-       CALL lpm_exchange_horiz
-
-    ENDIF
-!
-!-- In case of random_start_position, delete particles identified by 
-!-- lpm_exchange_horiz and lpm_boundary_conds. Then sort particles into blocks, 
-!-- which is needed for a fast interpolation of the LES fields on the particle 
-!-- position.
-    CALL lpm_pack_all_arrays
-
-!
-!-- Determine maximum number of particles (i.e., all possible particles that 
-!-- have been allocated) and the current number of particles
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-          DO  kp = nzb+1, nzt
-             maximum_number_of_particles = maximum_number_of_particles         &
-                                           + SIZE(grid_particles(kp,jp,ip)%particles)
-             number_of_particles         = number_of_particles                 &
-                                           + prt_count(kp,jp,ip)
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Calculate the number of particles of the total domain
-#if defined( __parallel )
-    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( number_of_particles, total_number_of_particles, 1, &
-    MPI_INTEGER, MPI_SUM, comm2d, ierr )
-#else
-    total_number_of_particles = number_of_particles
-#endif
-
-    RETURN
-
- END SUBROUTINE lpm_create_particle
-
- SUBROUTINE lpm_init_aerosols(local_start)
-
-    USE arrays_3d,                                                             &
-        ONLY: hyp, pt, q  
-
-    USE cloud_parameters,                                                      &
-        ONLY: l_d_rv, rho_l
-
-    USE constants,                                                             &
-        ONLY: pi
-
-    USE kinds
-
-    USE particle_attributes,                                                   &
-        ONLY: init_aerosol_probabilistic, molecular_weight_of_solute,          &
-              molecular_weight_of_water, n1, n2, n3, rho_s, rm1, rm2, rm3,     &
-              s1, s2, s3, vanthoff
-
-    IMPLICIT NONE
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cdf     !< CDF of aerosol spectrum 
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  r_temp  !< dry aerosol radius spectrum
-
-    REAL(wp)  :: bfactor            !< solute effects
-    REAL(wp)  :: dr                 !< width of radius bin
-    REAL(wp)  :: e_a                !< vapor pressure
-    REAL(wp)  :: e_s                !< saturation vapor pressure
-    REAL(wp)  :: n_init             !< sum of all aerosol concentrations
-    REAL(wp)  :: pdf                !< PDF of aerosol spectrum
-    REAL(wp)  :: rmin = 1.0e-8_wp   !< minimum aerosol radius
-    REAL(wp)  :: rmax = 1.0e-6_wp   !< maximum aerosol radius
-    REAL(wp)  :: rs_rand            !< random number
-    REAL(wp)  :: r_mid              !< mean radius
-    REAL(wp)  :: t_int              !< temperature
-    REAL(wp)  :: weight_sum         !< sum of all weighting factors
-
-    INTEGER(iwp), DIMENSION(:,:,:), INTENT(IN) ::  local_start !<
-
-    INTEGER(iwp)  :: n              !<
-    INTEGER(iwp)  :: nn             !<
-    INTEGER(iwp)  :: no_bins = 999  !< number of bins
-    INTEGER(iwp)  :: ip             !<
-    INTEGER(iwp)  :: jp             !<
-    INTEGER(iwp)  :: kp             !<
-
-    LOGICAL ::  new_pdf = .FALSE.   !< check if aerosol PDF has to be recalculated
-
-!
-!-- Compute aerosol background distribution
-    IF ( init_aerosol_probabilistic )  THEN
-       ALLOCATE( cdf(0:no_bins), r_temp(0:no_bins) )
-       DO n = 0, no_bins
-          r_temp(n) = EXP( LOG(rmin) + ( LOG(rmax) - LOG(rmin ) ) /            &
-                           REAL(no_bins, KIND=wp) * REAL(n, KIND=wp) )
-
-          cdf(n) = 0.0_wp
-          n_init = n1 + n2 + n3
-          IF ( n1 > 0.0_wp )  THEN 
-             cdf(n) = cdf(n) + n1 / n_init * ( 0.5_wp + 0.5_wp *        &
-                                  ERF( LOG( r_temp(n) / rm1 ) /         &
-                                       ( SQRT(2.0_wp) * LOG(s1) )       &
-                                     ) )
-          ENDIF
-          IF ( n2 > 0.0_wp )  THEN 
-             cdf(n) = cdf(n) + n2 / n_init * ( 0.5_wp + 0.5_wp *        &
-                                  ERF( LOG( r_temp(n) / rm2 ) /         &
-                                       ( SQRT(2.0_wp) * LOG(s2) )       &
-                                     ) )
-          ENDIF
-          IF ( n3 > 0.0_wp )  THEN 
-             cdf(n) = cdf(n) + n3 / n_init * ( 0.5_wp + 0.5_wp *        &
-                                  ERF( LOG( r_temp(n) / rm3 ) /         &
-                                       ( SQRT(2.0_wp) * LOG(s3) )       &
-                                     ) )
-          ENDIF
-
-       ENDDO
-    ENDIF
-
-    DO  ip = nxl, nxr
-       DO  jp = nys, nyn
-          DO  kp = nzb+1, nzt
-
-             number_of_particles = prt_count(kp,jp,ip)
-             IF ( number_of_particles <= 0 )  CYCLE
-             particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
-!
-!--          Initialize the aerosols with a predefined spectral distribution
-!--          of the dry radius (logarithmically increasing bins) and a varying 
-!--          weighting factor
-             IF ( .NOT. init_aerosol_probabilistic )  THEN
-
-                new_pdf = .FALSE.
-                IF ( .NOT. ALLOCATED( r_temp ) )  THEN
-                   new_pdf = .TRUE.
-                ELSE
-                   IF ( SIZE( r_temp ) .NE. &
-                        number_of_particles - local_start(kp,jp,ip) + 2 )  THEN
-                      new_pdf = .TRUE.
-                      DEALLOCATE( r_temp )
-                   ENDIF
-                ENDIF
-
-                IF ( new_pdf )  THEN
-
-                   no_bins = number_of_particles + 1 - local_start(kp,jp,ip)
-                   ALLOCATE( r_temp(0:no_bins) )
-
-                   DO n = 0, no_bins
-                      r_temp(n) = EXP( LOG(rmin) + ( LOG(rmax) - LOG(rmin ) ) / &
-                                       REAL(no_bins, KIND=wp) *                 &
-                                       REAL(n, KIND=wp) )
-                   ENDDO
-
-                ENDIF
-
-!
-!--             Calculate radius and concentration of each aerosol
-                DO n = local_start(kp,jp,ip), number_of_particles
-
-                   nn = n - local_start(kp,jp,ip)
-
-                   r_mid = SQRT( r_temp(nn) * r_temp(nn+1) )
-                   dr    = r_temp(nn+1) - r_temp(nn)
-
-                   pdf    = 0.0_wp
-                   n_init = n1 + n2 + n3
-                   IF ( n1 > 0.0_wp )  THEN 
-                      pdf = pdf + n1 / n_init * ( 1.0_wp / ( r_mid * LOG(s1) *      &
-                                                             SQRT( 2.0_wp * pi )    &
-                                                           ) *                      &
-                                                  EXP( -( LOG( r_mid / rm1 ) )**2 / &
-                                                       ( 2.0_wp * LOG(s1)**2 )      &
-                                                     )                              &
-                                                )
-                   ENDIF
-                   IF ( n2 > 0.0_wp )  THEN
-                      pdf = pdf + n2 / n_init * ( 1.0_wp / ( r_mid * LOG(s2) *      &
-                                                             SQRT( 2.0_wp * pi )    &
-                                                           ) *                      &
-                                                  EXP( -( LOG( r_mid / rm2 ) )**2 / &
-                                                       ( 2.0_wp * LOG(s2)**2 )      &
-                                                     )                              &
-                                                )
-                   ENDIF
-                   IF ( n3 > 0.0_wp )  THEN
-                      pdf = pdf + n3 / n_init * ( 1.0_wp / ( r_mid * LOG(s3) *      &
-                                                             SQRT( 2.0_wp * pi )    &
-                                                           ) *                      &
-                                                  EXP( -( LOG( r_mid / rm3 ) )**2 / &
-                                                       ( 2.0_wp * LOG(s3)**2 )      &
-                                                     )                              &
-                                                )
-                   ENDIF
-
-                   particles(n)%rvar2         = r_mid
-                   particles(n)%weight_factor = pdf * dr
-
-                END DO
-!
-!--             Adjust weighting factors to initialize the same number of aerosols
-!--             in every grid box
-                weight_sum = SUM(particles(local_start(kp,jp,ip):number_of_particles)%weight_factor)
-
-                particles(local_start(kp,jp,ip):number_of_particles)%weight_factor =     &
-                   particles(local_start(kp,jp,ip):number_of_particles)%weight_factor /  &
-                   weight_sum * initial_weighting_factor * ( no_bins + 1 )
-
-             ENDIF
-!
-!--          Initialize the aerosols with a predefined weighting factor but 
-!--          a randomly choosen dry radius
-             IF ( init_aerosol_probabilistic )  THEN
-
-                DO  n = local_start(kp,jp,ip), number_of_particles  !only new particles 
-
-                   rs_rand = -1.0_wp
-                   DO WHILE ( rs_rand .LT. cdf(0)  .OR.  rs_rand .GE. cdf(no_bins)  )
-                      rs_rand = random_function( iran_part )
-                   ENDDO
-!
-!--                Determine aerosol dry radius by a random number generator
-                   DO nn = 0, no_bins-1
-                      IF ( cdf(nn) .LE. rs_rand  .AND.  cdf(nn+1) .GT. rs_rand )  THEN
-                         particles(n)%rvar2 = r_temp(nn) + ( r_temp(nn+1) - r_temp(nn) ) / &
-                                              ( cdf(nn+1) - cdf(nn) ) * ( rs_rand - cdf(nn) )
-                         EXIT
-                      ENDIF
-                   ENDDO
-
-                ENDDO
-
-             ENDIF
-
-!
-!--          Set particle radius to equilibrium radius based on the environmental
-!--          supersaturation (Khvorostyanov and Curry, 2007, JGR). This avoids
-!--          the sometimes lengthy growth toward their equilibrium radius within 
-!--          the simulation.
-             t_int  = pt(kp,jp,ip) * ( hyp(kp) / 100000.0_wp )**0.286_wp
-
-             e_s = 611.0_wp * EXP( l_d_rv * ( 3.6609E-3_wp - 1.0_wp / t_int ) )
-             e_a = q(kp,jp,ip) * hyp(kp) / ( 0.378_wp * q(kp,jp,ip) + 0.622_wp )
-
-!
-!--          The formula is only valid for subsaturated environments. In (super-)
-!--          saturated air, the inital radius is used.
-             IF ( e_a / e_s < 1.0_wp )  THEN
-
-                DO  n = local_start(kp,jp,ip), number_of_particles  !only new particles 
-
-                   bfactor             = vanthoff * molecular_weight_of_water *    &
-                                         rho_s * particles(n)%rvar2**3 /           &
-                                         ( molecular_weight_of_solute * rho_l )
-                   particles(n)%radius = particles(n)%rvar2 * ( bfactor /          &
-                                         particles(n)%rvar2**3 )**(1.0_wp/3.0_wp) *&
-                                         ( 1.0_wp - e_a / e_s )**(-1.0_wp/3.0_wp)
-
-                ENDDO
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Deallocate used arrays
-    IF ( ALLOCATED(r_temp) )  DEALLOCATE( r_temp )
-    IF ( ALLOCATED(cdf) )     DEALLOCATE( cdf )
-
- END SUBROUTINE lpm_init_aerosols
-
-END MODULE lpm_init_mod
Index: /palm/trunk/SOURCE/production_e.f90
===================================================================
--- /palm/trunk/SOURCE/production_e.f90	(revision 1873)
+++ /palm/trunk/SOURCE/production_e.f90	(revision 1873)
@@ -0,0 +1,1999 @@
+!> @file production_e.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1691 2015-10-26 16:17:44Z maronga
+! Renamed prandtl_layer to constant_flux_layer.
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1374 2014-04-25 12:55:07Z raasch
+! nzb_s_outer removed from acc-present-list
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+! 
+! 1342 2014-03-26 17:04:47Z kanani
+! REAL constants defined as wp-kind
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! old module precision_kind is removed,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1257 2013-11-08 15:18:40Z raasch
+! openacc loop and loop vector clauses removed, declare create moved after
+! the FORTRAN declaration statement
+!
+! 1179 2013-06-14 05:57:58Z raasch
+! use_reference renamed use_single_reference_value
+!
+! 1128 2013-04-12 06:19:32Z raasch
+! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
+! j_north
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1015 2012-09-27 09:23:24Z raasch
+! accelerator version (*_acc) added
+!
+! 1007 2012-09-19 14:30:36Z franke
+! Bugfix: calculation of buoyancy production has to consider the liquid water
+! mixing ratio in case of cloud droplets
+!
+! 940 2012-07-09 14:31:00Z raasch
+! TKE production by buoyancy can be switched off in case of runs with pure
+! neutral stratification
+!
+! Revision 1.1  1997/09/19 07:45:35  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Production terms (shear + buoyancy) of the TKE.
+!> @warning The case with constant_flux_layer = F and use_surface_fluxes = T is
+!>          not considered well!
+!------------------------------------------------------------------------------!
+ MODULE production_e_mod
+ 
+
+    USE wall_fluxes_mod,                                                       &
+        ONLY:  wall_fluxes_e, wall_fluxes_e_acc
+
+    USE kinds
+
+    PRIVATE
+    PUBLIC production_e, production_e_acc, production_e_init
+
+    LOGICAL, SAVE ::  first_call = .TRUE.  !<
+
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  u_0  !<
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  v_0  !<
+
+    INTERFACE production_e
+       MODULE PROCEDURE production_e
+       MODULE PROCEDURE production_e_ij
+    END INTERFACE production_e
+    
+    INTERFACE production_e_acc
+       MODULE PROCEDURE production_e_acc
+    END INTERFACE production_e_acc
+
+    INTERFACE production_e_init
+       MODULE PROCEDURE production_e_init
+    END INTERFACE production_e_init
+ 
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE production_e
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, dd2zu, kh, km, pt, q, ql, qsws, qswst, rho, shf,       &
+                  tend, tswst, u, v, vpt, w
+
+       USE cloud_parameters,                                                   &
+           ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
+
+       USE control_parameters,                                                 &
+           ONLY:  cloud_droplets, cloud_physics, constant_flux_layer, g,       &
+                  humidity, kappa, neutral, ocean, pt_reference,               &
+                  rho_reference, use_single_reference_value,                   &
+                  use_surface_fluxes, use_top_fluxes
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, dx, ddy, dy, wall_e_x, wall_e_y
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nys, nyn, nzb, nzb_diff_s_inner,                   &
+                   nzb_diff_s_outer, nzb_s_inner, nzt, nzt_diff
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i           !<
+       INTEGER(iwp) ::  j           !<
+       INTEGER(iwp) ::  k           !<
+
+       REAL(wp)     ::  def         !<
+       REAL(wp)     ::  dudx        !<
+       REAL(wp)     ::  dudy        !<
+       REAL(wp)     ::  dudz        !<
+       REAL(wp)     ::  dvdx        !<
+       REAL(wp)     ::  dvdy        !<
+       REAL(wp)     ::  dvdz        !<
+       REAL(wp)     ::  dwdx        !<
+       REAL(wp)     ::  dwdy        !<
+       REAL(wp)     ::  dwdz        !<
+       REAL(wp)     ::  k1          !<
+       REAL(wp)     ::  k2          !<
+       REAL(wp)     ::  km_neutral  !<
+       REAL(wp)     ::  theta       !<
+       REAL(wp)     ::  temp        !<
+
+!       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs, vsus, wsus, wsvs
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  usvs  !<
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  vsus  !<
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsus  !<
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsvs  !<
+
+!
+!--    First calculate horizontal momentum flux u'v', w'v', v'u', w'u' at
+!--    vertical walls, if neccessary
+!--    So far, results are slightly different from the ij-Version.
+!--    Therefore, ij-Version is called further below within the ij-loops.
+!       IF ( topography /= 'flat' )  THEN
+!          CALL wall_fluxes_e( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, wall_e_y )
+!          CALL wall_fluxes_e( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, wall_e_y )
+!          CALL wall_fluxes_e( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, wall_e_x )
+!          CALL wall_fluxes_e( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, wall_e_x )
+!       ENDIF
+
+
+       DO  i = nxl, nxr
+
+!
+!--       Calculate TKE production by shear
+          DO  j = nys, nyn
+             DO  k = nzb_diff_s_outer(j,i), nzt
+
+                dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                    u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                    u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+                dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                    v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                    v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+                dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                    w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                    w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+                def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                      dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                      dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                IF ( def < 0.0_wp )  def = 0.0_wp
+
+                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+             ENDDO
+          ENDDO
+
+          IF ( constant_flux_layer )  THEN
+
+!
+!--          Position beneath wall
+!--          (2) - Will allways be executed.
+!--          'bottom and wall: use u_0,v_0 and wall functions'
+             DO  j = nys, nyn
+
+                IF ( ( wall_e_x(j,i) /= 0.0_wp ) .OR. ( wall_e_y(j,i) /= 0.0_wp ) ) &
+                THEN
+
+                   k = nzb_diff_s_inner(j,i) - 1
+                   dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+                   dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                     u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
+                   dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+                   dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                     v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
+                   dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+                   IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
+!
+!--                   Inconsistency removed: as the thermal stratification is 
+!--                   not taken into account for the evaluation of the wall 
+!--                   fluxes at vertical walls, the eddy viscosity km must not 
+!--                   be used for the evaluation of the velocity gradients dudy 
+!--                   and dwdy
+!--                   Note: The validity of the new method has not yet been 
+!--                         shown, as so far no suitable data for a validation 
+!--                         has been available
+                      CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+                                          usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
+                      CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+                                          wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
+                      km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25_wp * &
+                                   0.5_wp * dy 
+                      IF ( km_neutral > 0.0_wp )  THEN
+                         dudy = - wall_e_y(j,i) * usvs(k) / km_neutral
+                         dwdy = - wall_e_y(j,i) * wsvs(k) / km_neutral
+                      ELSE
+                         dudy = 0.0_wp
+                         dwdy = 0.0_wp
+                      ENDIF
+                   ELSE
+                      dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                         u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                      dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                         w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                   ENDIF
+
+                   IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
+!
+!--                   Inconsistency removed: as the thermal stratification is 
+!--                   not taken into account for the evaluation of the wall 
+!--                   fluxes at vertical walls, the eddy viscosity km must not 
+!--                   be used for the evaluation of the velocity gradients dvdx 
+!--                   and dwdx
+!--                   Note: The validity of the new method has not yet been 
+!--                         shown, as so far no suitable data for a validation 
+!--                         has been available
+                      CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+                                          vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
+                      CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+                                          wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
+                      km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25_wp * &
+                                   0.5_wp * dx
+                      IF ( km_neutral > 0.0_wp )  THEN
+                         dvdx = - wall_e_x(j,i) * vsus(k) / km_neutral
+                         dwdx = - wall_e_x(j,i) * wsus(k) / km_neutral
+                      ELSE
+                         dvdx = 0.0_wp
+                         dwdx = 0.0_wp
+                      ENDIF
+                   ELSE
+                      dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                         v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                      dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                         w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                   ENDIF
+
+                   def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                         dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                         dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                   IF ( def < 0.0_wp )  def = 0.0_wp
+
+                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+
+!
+!--                (3) - will be executed only, if there is at least one level
+!--                between (2) and (4), i.e. the topography must have a
+!--                minimum height of 2 dz. Wall fluxes for this case have
+!--                already been calculated for (2).
+!--                'wall only: use wall functions'
+
+                   DO  k = nzb_diff_s_inner(j,i), nzb_diff_s_outer(j,i)-2
+
+                      dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+                      dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                        u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+                      dvdy =          ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                      dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                        v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+                      dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+                      IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
+!
+!--                      Inconsistency removed: as the thermal stratification 
+!--                      is not taken into account for the evaluation of the 
+!--                      wall fluxes at vertical walls, the eddy viscosity km 
+!--                      must not be used for the evaluation of the velocity 
+!--                      gradients dudy and dwdy
+!--                      Note: The validity of the new method has not yet 
+!--                            been shown, as so far no suitable data for a 
+!--                            validation has been available
+                         km_neutral = kappa * ( usvs(k)**2 + & 
+                                                wsvs(k)**2 )**0.25_wp * 0.5_wp * dy
+                         IF ( km_neutral > 0.0_wp )  THEN
+                            dudy = - wall_e_y(j,i) * usvs(k) / km_neutral
+                            dwdy = - wall_e_y(j,i) * wsvs(k) / km_neutral
+                         ELSE
+                            dudy = 0.0_wp
+                            dwdy = 0.0_wp
+                         ENDIF
+                      ELSE
+                         dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                            u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                         dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                            w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                      ENDIF
+
+                      IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
+!
+!--                      Inconsistency removed: as the thermal stratification 
+!--                      is not taken into account for the evaluation of the 
+!--                      wall fluxes at vertical walls, the eddy viscosity km 
+!--                      must not be used for the evaluation of the velocity 
+!--                      gradients dvdx and dwdx
+!--                      Note: The validity of the new method has not yet 
+!--                            been shown, as so far no suitable data for a 
+!--                            validation has been available
+                         km_neutral = kappa * ( vsus(k)**2 + & 
+                                                wsus(k)**2 )**0.25_wp * 0.5_wp * dx
+                         IF ( km_neutral > 0.0_wp )  THEN
+                            dvdx = - wall_e_x(j,i) * vsus(k) / km_neutral
+                            dwdx = - wall_e_x(j,i) * wsus(k) / km_neutral
+                         ELSE
+                            dvdx = 0.0_wp
+                            dwdx = 0.0_wp
+                         ENDIF
+                      ELSE
+                         dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                            v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                         dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                            w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                      ENDIF
+
+                      def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                           dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 +  &
+                           dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                      IF ( def < 0.0_wp )  def = 0.0_wp
+
+                      tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+                   ENDDO
+
+                ENDIF
+
+             ENDDO
+
+!
+!--          (4) - will allways be executed.
+!--          'special case: free atmosphere' (as for case (0))
+             DO  j = nys, nyn
+
+                IF ( ( wall_e_x(j,i) /= 0.0_wp ) .OR. ( wall_e_y(j,i) /= 0.0_wp ) ) &
+                THEN
+
+                   k = nzb_diff_s_outer(j,i)-1
+
+                   dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                   dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                       u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                   dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                       u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+                   dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                       v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                   dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                   dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                       v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+                   dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                       w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                   dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                       w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                   dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+                   def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                         dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                         dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                   IF ( def < 0.0_wp )  def = 0.0_wp
+
+                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+                ENDIF
+
+             ENDDO
+
+!
+!--          Position without adjacent wall
+!--          (1) - will allways be executed. 
+!--          'bottom only: use u_0,v_0'
+             DO  j = nys, nyn
+
+                IF ( ( wall_e_x(j,i) == 0.0_wp ) .AND. ( wall_e_y(j,i) == 0.0_wp ) ) &
+                THEN
+
+                   k = nzb_diff_s_inner(j,i)-1
+
+                   dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                   dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                       u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                   dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                       u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
+
+                   dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                       v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                   dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                   dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                       v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
+
+                   dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                       w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                   dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                       w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                   dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+                   def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                         dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                         dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                   IF ( def < 0.0_wp )  def = 0.0_wp
+
+                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+                ENDIF
+
+             ENDDO
+
+          ELSEIF ( use_surface_fluxes )  THEN
+
+             DO  j = nys, nyn
+
+                k = nzb_diff_s_outer(j,i)-1
+
+                dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                    u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                   u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+                dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                    v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                    v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+                dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                    w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                    w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+                def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                      dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                      dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                IF ( def < 0.0_wp )  def = 0.0_wp
+
+                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+             ENDDO
+
+          ENDIF
+
+!
+!--       If required, calculate TKE production by buoyancy
+          IF ( .NOT. neutral )  THEN
+
+             IF ( .NOT. humidity )  THEN
+
+                IF ( use_single_reference_value )  THEN
+
+                   IF ( ocean )  THEN
+!
+!--                   So far in the ocean no special treatment of density flux
+!--                   in the bottom and top surface layer
+                      DO  j = nys, nyn
+                         DO  k = nzb_s_inner(j,i)+1, nzt
+                            tend(k,j,i) = tend(k,j,i) +                     &
+                                          kh(k,j,i) * g / rho_reference *   &
+                                          ( rho(k+1,j,i) - rho(k-1,j,i) ) * &
+                                          dd2zu(k)
+                         ENDDO
+                      ENDDO
+
+                   ELSE
+
+                      DO  j = nys, nyn
+                         DO  k = nzb_diff_s_inner(j,i), nzt_diff
+                            tend(k,j,i) = tend(k,j,i) -                   &
+                                          kh(k,j,i) * g / pt_reference *  &
+                                          ( pt(k+1,j,i) - pt(k-1,j,i) ) * &
+                                          dd2zu(k)
+                         ENDDO
+
+                         IF ( use_surface_fluxes )  THEN
+                            k = nzb_diff_s_inner(j,i)-1
+                            tend(k,j,i) = tend(k,j,i) + g / pt_reference * &
+                                                        shf(j,i)
+                         ENDIF
+
+                         IF ( use_top_fluxes )  THEN
+                            k = nzt
+                            tend(k,j,i) = tend(k,j,i) + g / pt_reference * &
+                                                        tswst(j,i)
+                         ENDIF
+                      ENDDO
+
+                   ENDIF
+
+                ELSE
+
+                   IF ( ocean )  THEN
+!
+!--                   So far in the ocean no special treatment of density flux
+!--                   in the bottom and top surface layer
+                      DO  j = nys, nyn
+                         DO  k = nzb_s_inner(j,i)+1, nzt
+                            tend(k,j,i) = tend(k,j,i) +                     &
+                                          kh(k,j,i) * g / rho(k,j,i) *      &
+                                          ( rho(k+1,j,i) - rho(k-1,j,i) ) * &
+                                          dd2zu(k)
+                         ENDDO
+                      ENDDO
+
+                   ELSE
+
+                      DO  j = nys, nyn
+                         DO  k = nzb_diff_s_inner(j,i), nzt_diff
+                            tend(k,j,i) = tend(k,j,i) -                   &
+                                          kh(k,j,i) * g / pt(k,j,i) *     &
+                                          ( pt(k+1,j,i) - pt(k-1,j,i) ) * &
+                                          dd2zu(k)
+                         ENDDO
+
+                         IF ( use_surface_fluxes )  THEN
+                            k = nzb_diff_s_inner(j,i)-1
+                            tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * &
+                                                        shf(j,i)
+                         ENDIF
+
+                         IF ( use_top_fluxes )  THEN
+                            k = nzt
+                            tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * &
+                                                        tswst(j,i)
+                         ENDIF
+                      ENDDO
+
+                   ENDIF
+
+                ENDIF
+
+             ELSE
+
+                DO  j = nys, nyn
+
+                   DO  k = nzb_diff_s_inner(j,i), nzt_diff
+
+                      IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                         tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *               &
+                                         g / vpt(k,j,i) *                      &
+                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
+                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
+                                         ) * dd2zu(k)
+                      ELSE IF ( cloud_physics )  THEN
+                         IF ( ql(k,j,i) == 0.0_wp )  THEN
+                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                            k2 = 0.61_wp * pt(k,j,i)
+                         ELSE
+                            theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                            temp  = theta * t_d_pt(k)
+                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
+                                          ( q(k,j,i) - ql(k,j,i) ) *          &
+                                 ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
+                                 ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
+                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                            k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                         ENDIF
+                         tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *               &
+                                         g / vpt(k,j,i) *                      &
+                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
+                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
+                                         ) * dd2zu(k)
+                      ELSE IF ( cloud_droplets )  THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                         tend(k,j,i) = tend(k,j,i) -                          & 
+                                       kh(k,j,i) * g / vpt(k,j,i) *           &
+                                       ( k1 * ( pt(k+1,j,i)- pt(k-1,j,i) ) +  &
+                                         k2 * ( q(k+1,j,i) -  q(k-1,j,i) ) -  &
+                                         pt(k,j,i) * ( ql(k+1,j,i) -          &
+                                         ql(k-1,j,i) ) ) * dd2zu(k)
+                      ENDIF
+
+                   ENDDO
+
+                ENDDO
+
+                IF ( use_surface_fluxes )  THEN
+
+                   DO  j = nys, nyn
+
+                      k = nzb_diff_s_inner(j,i)-1
+
+                      IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                      ELSE IF ( cloud_physics )  THEN
+                         IF ( ql(k,j,i) == 0.0_wp )  THEN
+                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                            k2 = 0.61_wp * pt(k,j,i)
+                         ELSE
+                            theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                            temp  = theta * t_d_pt(k)
+                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
+                                          ( q(k,j,i) - ql(k,j,i) ) *           &
+                                 ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /      &
+                                 ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *        &
+                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                            k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                         ENDIF
+                      ELSE IF ( cloud_droplets )  THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                      ENDIF
+
+                      tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
+                                            ( k1* shf(j,i) + k2 * qsws(j,i) )
+                   ENDDO
+
+                ENDIF
+
+                IF ( use_top_fluxes )  THEN
+
+                   DO  j = nys, nyn
+
+                      k = nzt
+
+                      IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                      ELSE IF ( cloud_physics )  THEN
+                         IF ( ql(k,j,i) == 0.0_wp )  THEN
+                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                            k2 = 0.61_wp * pt(k,j,i)
+                         ELSE
+                            theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                            temp  = theta * t_d_pt(k)
+                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
+                                          ( q(k,j,i) - ql(k,j,i) ) *           &
+                                 ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /      &
+                                 ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *        &
+                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                            k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                         ENDIF
+                      ELSE IF ( cloud_droplets )  THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                      ENDIF
+
+                      tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
+                                            ( k1* tswst(j,i) + k2 * qswst(j,i) )
+                   ENDDO
+
+                ENDIF
+
+             ENDIF
+
+          ENDIF
+
+       ENDDO
+
+    END SUBROUTINE production_e
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE production_e_acc
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, dd2zu, kh, km, pt, q, ql, qsws, qswst, rho, shf,       &
+                  tend, tswst, u, v, vpt, w
+
+       USE cloud_parameters,                                                   &
+           ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
+
+       USE control_parameters,                                                 &
+           ONLY:  cloud_droplets, cloud_physics, constant_flux_layer, g,       &
+                  humidity, kappa, neutral, ocean, pt_reference,               &
+                  rho_reference, topography, use_single_reference_value,       &
+                  use_surface_fluxes, use_top_fluxes
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, dx, ddy, dy, wall_e_x, wall_e_y
+
+       USE indices,                                                            &
+           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nys, nyn, nzb,  &
+                  nzb_diff_s_inner, nzb_diff_s_outer, nzb_s_inner, nzt,        &
+                  nzt_diff
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i           !<
+       INTEGER(iwp) ::  j           !<
+       INTEGER(iwp) ::  k           !<
+
+       REAL(wp)     ::  def         !<
+       REAL(wp)     ::  dudx        !<
+       REAL(wp)     ::  dudy        !<
+       REAL(wp)     ::  dudz        !<
+       REAL(wp)     ::  dvdx        !<
+       REAL(wp)     ::  dvdy        !<
+       REAL(wp)     ::  dvdz        !<
+       REAL(wp)     ::  dwdx        !<
+       REAL(wp)     ::  dwdy        !<
+       REAL(wp)     ::  dwdz        !<
+       REAL(wp)     ::  k1          !<
+       REAL(wp)     ::  k2          !<
+       REAL(wp)     ::  km_neutral  !<
+       REAL(wp)     ::  theta       !<
+       REAL(wp)     ::  temp        !<
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs  !<
+       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  vsus  !<
+       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus  !<
+       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsvs  !<
+       !$acc declare create ( usvs, vsus, wsus, wsvs )
+
+!
+!--    First calculate horizontal momentum flux u'v', w'v', v'u', w'u' at
+!--    vertical walls, if neccessary
+!--    CAUTION: results are slightly different from the ij-version!!
+!--    ij-version should be called further below within the ij-loops!!
+       IF ( topography /= 'flat' )  THEN
+          CALL wall_fluxes_e_acc( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, wall_e_y )
+          CALL wall_fluxes_e_acc( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, wall_e_y )
+          CALL wall_fluxes_e_acc( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, wall_e_x )
+          CALL wall_fluxes_e_acc( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, wall_e_x )
+       ENDIF
+
+
+!
+!--    Calculate TKE production by shear
+       !$acc kernels present( ddzw, dd2zu, kh, km, nzb_diff_s_inner, nzb_diff_s_outer ) &
+       !$acc         present( nzb_s_inner, pt, q, ql, qsws, qswst, rho )                &
+       !$acc         present( shf, tend, tswst, u, v, vpt, w, wall_e_x, wall_e_y )      &
+       !$acc         copyin( u_0, v_0 )
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+             DO  k = 1, nzt
+
+                IF ( k >= nzb_diff_s_outer(j,i) )  THEN
+
+                   dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                   dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                       u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                   dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                       u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+                   dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                       v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                   dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                   dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                       v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+                   dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                       w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                   dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                       w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                   dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+                   def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                         dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                         dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                   IF ( def < 0.0_wp )  def = 0.0_wp
+
+                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+                ENDIF
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+       IF ( constant_flux_layer )  THEN
+
+!
+!--       Position beneath wall
+!--       (2) - Will allways be executed.
+!--       'bottom and wall: use u_0,v_0 and wall functions'
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+                DO  k = 1, nzt
+
+                   IF ( ( wall_e_x(j,i) /= 0.0_wp ).OR.( wall_e_y(j,i) /= 0.0_wp ) ) &
+                   THEN
+
+                      IF ( k == nzb_diff_s_inner(j,i) - 1 )  THEN
+                         dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+                         dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                           u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
+                         dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+                         dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                           v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
+                         dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+                         IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
+!
+!--                         Inconsistency removed: as the thermal stratification is
+!--                         not taken into account for the evaluation of the wall
+!--                         fluxes at vertical walls, the eddy viscosity km must not
+!--                         be used for the evaluation of the velocity gradients dudy
+!--                         and dwdy
+!--                         Note: The validity of the new method has not yet been
+!--                               shown, as so far no suitable data for a validation
+!--                               has been available
+!                            CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+!                                                usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
+!                            CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+!                                                wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
+                            km_neutral = kappa *                                    &
+                                        ( usvs(k,j,i)**2 + wsvs(k,j,i)**2 )**0.25_wp * &
+                                         0.5_wp * dy
+                            IF ( km_neutral > 0.0_wp )  THEN
+                               dudy = - wall_e_y(j,i) * usvs(k,j,i) / km_neutral
+                               dwdy = - wall_e_y(j,i) * wsvs(k,j,i) / km_neutral
+                            ELSE
+                               dudy = 0.0_wp
+                               dwdy = 0.0_wp
+                            ENDIF
+                         ELSE
+                            dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                               u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                            dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                               w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                         ENDIF
+
+                         IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
+!
+!--                         Inconsistency removed: as the thermal stratification is
+!--                         not taken into account for the evaluation of the wall
+!--                         fluxes at vertical walls, the eddy viscosity km must not
+!--                         be used for the evaluation of the velocity gradients dvdx
+!--                         and dwdx
+!--                         Note: The validity of the new method has not yet been
+!--                               shown, as so far no suitable data for a validation
+!--                               has been available
+!                            CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+!                                                vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
+!                            CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+!                                                wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
+                            km_neutral = kappa *                                     &
+                                         ( vsus(k,j,i)**2 + wsus(k,j,i)**2 )**0.25_wp * &
+                                         0.5_wp * dx
+                            IF ( km_neutral > 0.0_wp )  THEN
+                               dvdx = - wall_e_x(j,i) * vsus(k,j,i) / km_neutral
+                               dwdx = - wall_e_x(j,i) * wsus(k,j,i) / km_neutral
+                            ELSE
+                               dvdx = 0.0_wp
+                               dwdx = 0.0_wp
+                            ENDIF
+                         ELSE
+                            dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                               v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                            dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                               w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                         ENDIF
+
+                         def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                               dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                               dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                         IF ( def < 0.0_wp )  def = 0.0_wp
+
+                         tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+                      ENDIF
+!
+!--                   (3) - will be executed only, if there is at least one level
+!--                   between (2) and (4), i.e. the topography must have a
+!--                   minimum height of 2 dz. Wall fluxes for this case have
+!--                   already been calculated for (2).
+!--                   'wall only: use wall functions'
+
+                      IF ( k >= nzb_diff_s_inner(j,i)  .AND.  &
+                           k <= nzb_diff_s_outer(j,i)-2 )  THEN
+
+                         dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+                         dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                           u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+                         dvdy =          ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                         dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                           v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+                         dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+                         IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
+!
+!--                         Inconsistency removed: as the thermal stratification
+!--                         is not taken into account for the evaluation of the
+!--                         wall fluxes at vertical walls, the eddy viscosity km
+!--                         must not be used for the evaluation of the velocity
+!--                         gradients dudy and dwdy
+!--                         Note: The validity of the new method has not yet
+!--                               been shown, as so far no suitable data for a
+!--                               validation has been available
+                            km_neutral = kappa * ( usvs(k,j,i)**2 + &
+                                                   wsvs(k,j,i)**2 )**0.25_wp * 0.5_wp * dy
+                            IF ( km_neutral > 0.0_wp )  THEN
+                               dudy = - wall_e_y(j,i) * usvs(k,j,i) / km_neutral
+                               dwdy = - wall_e_y(j,i) * wsvs(k,j,i) / km_neutral
+                            ELSE
+                               dudy = 0.0_wp
+                               dwdy = 0.0_wp
+                            ENDIF
+                         ELSE
+                            dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                               u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                            dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                               w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                         ENDIF
+
+                         IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
+!
+!--                         Inconsistency removed: as the thermal stratification
+!--                         is not taken into account for the evaluation of the
+!--                         wall fluxes at vertical walls, the eddy viscosity km
+!--                         must not be used for the evaluation of the velocity
+!--                         gradients dvdx and dwdx
+!--                         Note: The validity of the new method has not yet
+!--                               been shown, as so far no suitable data for a
+!--                               validation has been available
+                            km_neutral = kappa * ( vsus(k,j,i)**2 + &
+                                                   wsus(k,j,i)**2 )**0.25_wp * 0.5_wp * dx
+                            IF ( km_neutral > 0.0_wp )  THEN
+                               dvdx = - wall_e_x(j,i) * vsus(k,j,i) / km_neutral
+                               dwdx = - wall_e_x(j,i) * wsus(k,j,i) / km_neutral
+                            ELSE
+                               dvdx = 0.0_wp
+                               dwdx = 0.0_wp
+                            ENDIF
+                         ELSE
+                            dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                               v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                            dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                               w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                         ENDIF
+
+                         def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                              dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 +  &
+                              dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                         IF ( def < 0.0_wp )  def = 0.0_wp
+
+                         tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+                      ENDIF
+
+!
+!--                   (4) - will allways be executed.
+!--                   'special case: free atmosphere' (as for case (0))
+                      IF ( k == nzb_diff_s_outer(j,i)-1 )  THEN
+
+                         dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                         dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                             u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                         dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                             u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+                         dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                             v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                         dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                         dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                             v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+                         dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                             w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                         dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                             w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                         dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+                         def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                               dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                               dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                         IF ( def < 0.0_wp )  def = 0.0_wp
+
+                         tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+                      ENDIF
+
+                   ENDIF
+
+                ENDDO
+             ENDDO
+          ENDDO
+
+!
+!--       Position without adjacent wall
+!--       (1) - will allways be executed.
+!--       'bottom only: use u_0,v_0'
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+                DO  k = 1, nzt
+
+                   IF ( ( wall_e_x(j,i) == 0.0_wp ) .AND. ( wall_e_y(j,i) == 0.0_wp ) ) &
+                   THEN
+
+                      IF ( k == nzb_diff_s_inner(j,i)-1 )  THEN
+
+                         dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                         dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                             u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                         dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                             u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
+
+                         dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                             v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                         dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                         dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                             v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
+
+                         dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                             w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                         dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                             w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                         dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+                         def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                               dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                               dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                         IF ( def < 0.0_wp )  def = 0.0_wp
+
+                         tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+                      ENDIF
+
+                   ENDIF
+
+                ENDDO
+             ENDDO
+          ENDDO
+
+       ELSEIF ( use_surface_fluxes )  THEN
+
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+                 DO  k = 1, nzt
+
+                   IF ( k == nzb_diff_s_outer(j,i)-1 )  THEN
+
+                      dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                      dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                          u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                      dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                          u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+                      dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                          v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                      dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                      dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                          v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+                      dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                          w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                      dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                          w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                      dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+                      def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                            dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                            dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                      IF ( def < 0.0_wp )  def = 0.0_wp
+
+                      tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+                   ENDIF
+
+                ENDDO
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+!
+!--    If required, calculate TKE production by buoyancy
+       IF ( .NOT. neutral )  THEN
+
+          IF ( .NOT. humidity )  THEN
+
+             IF ( use_single_reference_value )  THEN
+
+                IF ( ocean )  THEN
+!
+!--                So far in the ocean no special treatment of density flux
+!--                in the bottom and top surface layer
+                   DO  i = i_left, i_right
+                      DO  j = j_south, j_north
+                         DO  k = 1, nzt
+                            IF ( k > nzb_s_inner(j,i) )  THEN
+                               tend(k,j,i) = tend(k,j,i) +                     &
+                                             kh(k,j,i) * g / rho_reference *   &
+                                             ( rho(k+1,j,i) - rho(k-1,j,i) ) * &
+                                             dd2zu(k)
+                            ENDIF
+                         ENDDO
+                      ENDDO
+                   ENDDO
+
+                ELSE
+
+                   DO  i = i_left, i_right
+                      DO  j = j_south, j_north
+                         DO  k = 1, nzt_diff
+                            IF ( k >= nzb_diff_s_inner(j,i) )  THEN
+                               tend(k,j,i) = tend(k,j,i) -                   &
+                                             kh(k,j,i) * g / pt_reference *  &
+                                             ( pt(k+1,j,i) - pt(k-1,j,i) ) * &
+                                             dd2zu(k)
+                            ENDIF
+
+                            IF ( k == nzb_diff_s_inner(j,i)-1  .AND.  &
+                                 use_surface_fluxes )  THEN
+                               tend(k,j,i) = tend(k,j,i) + g / pt_reference * &
+                                                           shf(j,i)
+                            ENDIF
+
+                            IF ( k == nzt  .AND.  use_top_fluxes )  THEN
+                               tend(k,j,i) = tend(k,j,i) + g / pt_reference * &
+                                                           tswst(j,i)
+                            ENDIF
+                         ENDDO
+                      ENDDO
+                   ENDDO
+
+                ENDIF
+
+             ELSE
+
+                IF ( ocean )  THEN
+!
+!--                So far in the ocean no special treatment of density flux
+!--                in the bottom and top surface layer
+                   DO  i = i_left, i_right
+                      DO  j = j_south, j_north
+                         DO  k = 1, nzt
+                            IF ( k > nzb_s_inner(j,i) )  THEN
+                               tend(k,j,i) = tend(k,j,i) +                     &
+                                             kh(k,j,i) * g / rho(k,j,i) *      &
+                                             ( rho(k+1,j,i) - rho(k-1,j,i) ) * &
+                                             dd2zu(k)
+                            ENDIF
+                         ENDDO
+                      ENDDO
+                   ENDDO
+
+                ELSE
+
+                   DO  i = i_left, i_right
+                      DO  j = j_south, j_north
+                         DO  k = 1, nzt_diff
+                            IF( k >= nzb_diff_s_inner(j,i) )  THEN
+                               tend(k,j,i) = tend(k,j,i) -                   &
+                                             kh(k,j,i) * g / pt(k,j,i) *     &
+                                             ( pt(k+1,j,i) - pt(k-1,j,i) ) * &
+                                             dd2zu(k)
+                            ENDIF
+
+                            IF (  k == nzb_diff_s_inner(j,i)-1  .AND.  &
+                                  use_surface_fluxes )  THEN
+                               tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * &
+                                                           shf(j,i)
+                            ENDIF
+
+                            IF ( k == nzt  .AND.  use_top_fluxes )  THEN
+                               tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * &
+                                                           tswst(j,i)
+                            ENDIF
+                         ENDDO
+                      ENDDO
+                   ENDDO
+
+                ENDIF
+
+             ENDIF
+
+          ELSE
+!
+!++          This part gives the PGI compiler problems in the previous loop
+!++          even without any acc statements????
+!             STOP '+++ production_e problems with acc-directives'
+!             !acc loop
+!             DO  i = nxl, nxr
+!                DO  j = nys, nyn
+!                   !acc loop vector
+!                   DO  k = 1, nzt_diff
+!
+!                      IF ( k >= nzb_diff_s_inner(j,i) )  THEN
+!
+!                         IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+!                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+!                            k2 = 0.61_wp * pt(k,j,i)
+!                            tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *               &
+!                                            g / vpt(k,j,i) *                      &
+!                                            ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
+!                                              k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
+!                                            ) * dd2zu(k)
+!                         ELSE IF ( cloud_physics )  THEN
+!                            IF ( ql(k,j,i) == 0.0_wp )  THEN
+!                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+!                               k2 = 0.61_wp * pt(k,j,i)
+!                            ELSE
+!                               theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+!                               temp  = theta * t_d_pt(k)
+!                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                 &
+!                                             ( q(k,j,i) - ql(k,j,i) ) *          &
+!                                    ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
+!                                    ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
+!                                    ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+!                               k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+!                            ENDIF
+!                            tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *               &
+!                                            g / vpt(k,j,i) *                      &
+!                                            ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
+!                                              k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
+!                                            ) * dd2zu(k)
+!                         ELSE IF ( cloud_droplets )  THEN
+!                            k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+!                            k2 = 0.61_wp * pt(k,j,i)
+!                            tend(k,j,i) = tend(k,j,i) -                          &
+!                                          kh(k,j,i) * g / vpt(k,j,i) *           &
+!                                          ( k1 * ( pt(k+1,j,i)- pt(k-1,j,i) ) +  &
+!                                            k2 * ( q(k+1,j,i) -  q(k-1,j,i) ) -  &
+!                                            pt(k,j,i) * ( ql(k+1,j,i) -          &
+!                                            ql(k-1,j,i) ) ) * dd2zu(k)
+!                         ENDIF
+!
+!                      ENDIF
+!
+!                   ENDDO
+!                ENDDO
+!             ENDDO
+!
+
+!!++          Next two loops are probably very inefficiently parallellized
+!!++          and will require better optimization
+!             IF ( use_surface_fluxes )  THEN
+!
+!                !acc loop
+!                DO  i = nxl, nxr
+!                   DO  j = nys, nyn
+!                      !acc loop vector
+!                      DO  k = 1, nzt_diff
+!
+!                         IF ( k == nzb_diff_s_inner(j,i)-1 )  THEN
+!
+!                            IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+!                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+!                               k2 = 0.61_wp * pt(k,j,i)
+!                            ELSE IF ( cloud_physics )  THEN
+!                               IF ( ql(k,j,i) == 0.0_wp )  THEN
+!                                  k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+!                                  k2 = 0.61_wp * pt(k,j,i)
+!                               ELSE
+!                                  theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+!                                  temp  = theta * t_d_pt(k)
+!                                  k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *        &
+!                                                ( q(k,j,i) - ql(k,j,i) ) *    &
+!                                       ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /&
+!                                       ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp * &
+!                                       ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+!                                  k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+!                               ENDIF
+!                            ELSE IF ( cloud_droplets )  THEN
+!                               k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+!                               k2 = 0.61_wp * pt(k,j,i)
+!                            ENDIF
+!
+!                            tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
+!                                                  ( k1* shf(j,i) + k2 * qsws(j,i) )
+!                         ENDIF
+!
+!                      ENDDO
+!                   ENDDO
+!                ENDDO
+!
+!             ENDIF
+!
+!             IF ( use_top_fluxes )  THEN
+!
+!                !acc loop
+!                DO  i = nxl, nxr
+!                   DO  j = nys, nyn
+!                      !acc loop vector
+!                      DO  k = 1, nzt
+!                         IF ( k == nzt )  THEN
+!
+!                            IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+!                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+!                               k2 = 0.61_wp * pt(k,j,i)
+!                            ELSE IF ( cloud_physics )  THEN
+!                               IF ( ql(k,j,i) == 0.0_wp )  THEN
+!                                  k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+!                                  k2 = 0.61_wp * pt(k,j,i)
+!                               ELSE
+!                                  theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+!                                  temp  = theta * t_d_pt(k)
+!                                  k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *        &
+!                                                ( q(k,j,i) - ql(k,j,i) ) *    &
+!                                       ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /&
+!                                       ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp * &
+!                                       ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+!                                  k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+!                               ENDIF
+!                            ELSE IF ( cloud_droplets )  THEN
+!                               k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+!                               k2 = 0.61_wp * pt(k,j,i)
+!                            ENDIF
+!
+!                            tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
+!                                                  ( k1* tswst(j,i) + k2 * qswst(j,i) )
+!
+!                         ENDIF
+!
+!                      ENDDO
+!                   ENDDO
+!                ENDDO
+!
+!             ENDIF
+
+          ENDIF
+
+       ENDIF
+       !$acc end kernels
+
+    END SUBROUTINE production_e_acc
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE production_e_ij( i, j )
+
+       USE arrays_3d,                                                          &
+           ONLY:  ddzw, dd2zu, kh, km, pt, q, ql, qsws, qswst, rho, shf,       &
+                  tend, tswst, u, v, vpt, w
+
+       USE cloud_parameters,                                                   &
+           ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
+
+       USE control_parameters,                                                 &
+           ONLY:  cloud_droplets, cloud_physics, constant_flux_layer, g,       &
+                  humidity, kappa, neutral, ocean, pt_reference,               &
+                  rho_reference, use_single_reference_value,                   &
+                  use_surface_fluxes, use_top_fluxes
+
+       USE grid_variables,                                                     &
+           ONLY:  ddx, dx, ddy, dy, wall_e_x, wall_e_y
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nys, nyn, nzb, nzb_diff_s_inner,                   &
+                  nzb_diff_s_outer, nzb_s_inner, nzt, nzt_diff
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i           !<
+       INTEGER(iwp) ::  j           !<
+       INTEGER(iwp) ::  k           !<
+
+       REAL(wp)     ::  def         !<
+       REAL(wp)     ::  dudx        !<
+       REAL(wp)     ::  dudy        !<
+       REAL(wp)     ::  dudz        !<
+       REAL(wp)     ::  dvdx        !<
+       REAL(wp)     ::  dvdy        !<
+       REAL(wp)     ::  dvdz        !<
+       REAL(wp)     ::  dwdx        !<
+       REAL(wp)     ::  dwdy        !<
+       REAL(wp)     ::  dwdz        !<
+       REAL(wp)     ::  k1          !<
+       REAL(wp)     ::  k2          !<
+       REAL(wp)     ::  km_neutral  !<
+       REAL(wp)     ::  theta       !<
+       REAL(wp)     ::  temp        !<
+
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  usvs  !<
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  vsus  !<
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsus  !<
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsvs  !<
+
+!
+!--    Calculate TKE production by shear
+       DO  k = nzb_diff_s_outer(j,i), nzt
+
+          dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+          dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                              u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+          dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                              u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+          dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                              v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+          dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+          dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                              v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+          dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                              w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+          dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                              w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+          dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+          def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 )                       &
+                + dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + dvdz**2    &
+                + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+          IF ( def < 0.0_wp )  def = 0.0_wp
+
+          tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+       ENDDO
+
+       IF ( constant_flux_layer )  THEN
+
+          IF ( ( wall_e_x(j,i) /= 0.0_wp ) .OR. ( wall_e_y(j,i) /= 0.0_wp ) )  THEN
+
+!
+!--          Position beneath wall
+!--          (2) - Will allways be executed.
+!--          'bottom and wall: use u_0,v_0 and wall functions'
+             k = nzb_diff_s_inner(j,i)-1
+
+             dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+             dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                               u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
+             dvdy =          ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+             dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                               v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
+             dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+             IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
+!
+!--             Inconsistency removed: as the thermal stratification 
+!--             is not taken into account for the evaluation of the 
+!--             wall fluxes at vertical walls, the eddy viscosity km 
+!--             must not be used for the evaluation of the velocity 
+!--             gradients dudy and dwdy
+!--             Note: The validity of the new method has not yet 
+!--                   been shown, as so far no suitable data for a 
+!--                   validation has been available
+                CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+                                    usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
+                CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+                                    wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
+                km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25_wp * &
+                             0.5_wp * dy
+                IF ( km_neutral > 0.0_wp )  THEN
+                   dudy = - wall_e_y(j,i) * usvs(k) / km_neutral
+                   dwdy = - wall_e_y(j,i) * wsvs(k) / km_neutral
+                ELSE
+                   dudy = 0.0_wp
+                   dwdy = 0.0_wp
+                ENDIF
+             ELSE
+                dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                   u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                   w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+             ENDIF
+
+             IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
+!
+!--             Inconsistency removed: as the thermal stratification 
+!--             is not taken into account for the evaluation of the 
+!--             wall fluxes at vertical walls, the eddy viscosity km 
+!--             must not be used for the evaluation of the velocity 
+!--             gradients dvdx and dwdx
+!--             Note: The validity of the new method has not yet 
+!--                   been shown, as so far no suitable data for a 
+!--                   validation has been available
+                CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+                                    vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
+                CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+                                    wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
+                km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25_wp * & 
+                             0.5_wp * dx
+                IF ( km_neutral > 0.0_wp )  THEN
+                   dvdx = - wall_e_x(j,i) * vsus(k) / km_neutral
+                   dwdx = - wall_e_x(j,i) * wsus(k) / km_neutral
+                ELSE
+                   dvdx = 0.0_wp
+                   dwdx = 0.0_wp
+                ENDIF
+             ELSE
+                dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                   v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                   w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+             ENDIF
+
+             def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                   dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                   dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+             IF ( def < 0.0_wp )  def = 0.0_wp
+
+             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+!
+!--          (3) - will be executed only, if there is at least one level
+!--          between (2) and (4), i.e. the topography must have a
+!--          minimum height of 2 dz. Wall fluxes for this case have
+!--          already been calculated for (2).
+!--          'wall only: use wall functions'
+             DO  k = nzb_diff_s_inner(j,i), nzb_diff_s_outer(j,i)-2
+
+                dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+                dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                  u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+                dvdy =          ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                  v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+                dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+                IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
+!
+!--                Inconsistency removed: as the thermal stratification 
+!--                is not taken into account for the evaluation of the 
+!--                wall fluxes at vertical walls, the eddy viscosity km 
+!--                must not be used for the evaluation of the velocity 
+!--                gradients dudy and dwdy
+!--                Note: The validity of the new method has not yet 
+!--                      been shown, as so far no suitable data for a 
+!--                      validation has been available
+                   km_neutral = kappa * ( usvs(k)**2 + & 
+                                          wsvs(k)**2 )**0.25_wp * 0.5_wp * dy
+                   IF ( km_neutral > 0.0_wp )  THEN
+                      dudy = - wall_e_y(j,i) * usvs(k) / km_neutral
+                      dwdy = - wall_e_y(j,i) * wsvs(k) / km_neutral
+                   ELSE
+                      dudy = 0.0_wp
+                      dwdy = 0.0_wp
+                   ENDIF
+                ELSE
+                   dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                      u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+                   dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                      w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+                ENDIF
+
+                IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
+!
+!--                Inconsistency removed: as the thermal stratification 
+!--                is not taken into account for the evaluation of the 
+!--                wall fluxes at vertical walls, the eddy viscosity km 
+!--                must not be used for the evaluation of the velocity 
+!--                gradients dvdx and dwdx
+!--                Note: The validity of the new method has not yet 
+!--                      been shown, as so far no suitable data for a 
+!--                      validation has been available
+                   km_neutral = kappa * ( vsus(k)**2 + & 
+                                          wsus(k)**2 )**0.25_wp * 0.5_wp * dx
+                   IF ( km_neutral > 0.0_wp )  THEN
+                      dvdx = - wall_e_x(j,i) * vsus(k) / km_neutral
+                      dwdx = - wall_e_x(j,i) * wsus(k) / km_neutral
+                   ELSE
+                      dvdx = 0.0_wp
+                      dwdx = 0.0_wp
+                   ENDIF
+                ELSE
+                   dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                      v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+                   dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                      w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+                ENDIF
+
+                def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                      dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                      dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+                IF ( def < 0.0_wp )  def = 0.0_wp
+
+                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+             ENDDO
+
+!
+!--          (4) - will allways be executed.
+!--          'special case: free atmosphere' (as for case (0))
+             k = nzb_diff_s_outer(j,i)-1
+
+             dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+             dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                 u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+             dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                 u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+             dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                 v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+             dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+             dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                 v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+             dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                 w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+             dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                 w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+             dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+             def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +        &
+                   dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                   dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+             IF ( def < 0.0_wp )  def = 0.0_wp
+
+             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+          ELSE
+
+!
+!--          Position without adjacent wall
+!--          (1) - will allways be executed. 
+!--          'bottom only: use u_0,v_0'
+             k = nzb_diff_s_inner(j,i)-1
+
+             dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+             dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                                 u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+             dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                                 u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
+
+             dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                                 v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+             dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+             dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                                 v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
+
+             dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                                 w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+             dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                                 w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+             dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+             def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 )                       &
+                   + dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + dvdz**2 &
+                   + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+             IF ( def < 0.0_wp )  def = 0.0_wp
+
+             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+          ENDIF
+
+       ELSEIF ( use_surface_fluxes )  THEN
+
+          k = nzb_diff_s_outer(j,i)-1
+
+          dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+          dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+                              u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+          dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+                              u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+          dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+                              v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+          dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+          dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+                              v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+          dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+                              w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+          dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+                              w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+          dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+          def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
+                dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+                dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+          IF ( def < 0.0_wp )  def = 0.0_wp
+
+          tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+       ENDIF
+
+!
+!--    If required, calculate TKE production by buoyancy
+       IF ( .NOT. neutral )  THEN
+
+          IF ( .NOT. humidity )  THEN
+
+             IF ( use_single_reference_value )  THEN
+
+                IF ( ocean )  THEN
+!
+!--                So far in the ocean no special treatment of density flux in
+!--                the bottom and top surface layer
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tend(k,j,i) = tend(k,j,i) +                   &
+                                    kh(k,j,i) * g / rho_reference * &
+                                    ( rho(k+1,j,i) - rho(k-1,j,i) ) * dd2zu(k)
+                   ENDDO
+
+                ELSE
+
+                   DO  k = nzb_diff_s_inner(j,i), nzt_diff
+                      tend(k,j,i) = tend(k,j,i) -                  &
+                                    kh(k,j,i) * g / pt_reference * &
+                                    ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k)
+                   ENDDO
+
+                   IF ( use_surface_fluxes )  THEN
+                      k = nzb_diff_s_inner(j,i)-1
+                      tend(k,j,i) = tend(k,j,i) + g / pt_reference * shf(j,i)
+                   ENDIF
+
+                   IF ( use_top_fluxes )  THEN
+                      k = nzt
+                      tend(k,j,i) = tend(k,j,i) + g / pt_reference * tswst(j,i)
+                   ENDIF
+
+                ENDIF
+
+             ELSE
+
+                IF ( ocean )  THEN
+!
+!--                So far in the ocean no special treatment of density flux in
+!--                the bottom and top surface layer
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tend(k,j,i) = tend(k,j,i) +                &
+                                    kh(k,j,i) * g / rho(k,j,i) * &
+                                    ( rho(k+1,j,i) - rho(k-1,j,i) ) * dd2zu(k)
+                   ENDDO
+
+                ELSE
+
+                   DO  k = nzb_diff_s_inner(j,i), nzt_diff
+                      tend(k,j,i) = tend(k,j,i) -               &
+                                    kh(k,j,i) * g / pt(k,j,i) * &
+                                    ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k)
+                   ENDDO
+
+                   IF ( use_surface_fluxes )  THEN
+                      k = nzb_diff_s_inner(j,i)-1
+                      tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * shf(j,i)
+                   ENDIF
+
+                   IF ( use_top_fluxes )  THEN
+                      k = nzt
+                      tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * tswst(j,i)
+                   ENDIF
+
+                ENDIF
+
+             ENDIF
+
+          ELSE
+
+             DO  k = nzb_diff_s_inner(j,i), nzt_diff
+
+                IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets )  THEN
+                   k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                   k2 = 0.61_wp * pt(k,j,i)
+                   tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g / vpt(k,j,i) *   &
+                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) + &
+                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )   &
+                                         ) * dd2zu(k)
+                ELSE IF ( cloud_physics )  THEN
+                   IF ( ql(k,j,i) == 0.0_wp )  THEN
+                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                      k2 = 0.61_wp * pt(k,j,i)
+                   ELSE
+                      theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                      temp  = theta * t_d_pt(k)
+                      k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                 &
+                                    ( q(k,j,i) - ql(k,j,i) ) *          &
+                           ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
+                           ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
+                           ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                      k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                   ENDIF
+                   tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g / vpt(k,j,i) *   &
+                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) + &
+                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )   &
+                                         ) * dd2zu(k)
+                ELSE IF ( cloud_droplets )  THEN
+                   k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                   k2 = 0.61_wp * pt(k,j,i)
+                   tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g / vpt(k,j,i) *  &
+                                     ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +    &
+                                       k2 * ( q(k+1,j,i) - q(k-1,j,i) ) -    &
+                                       pt(k,j,i) * ( ql(k+1,j,i) -           &
+                                                     ql(k-1,j,i) ) ) * dd2zu(k)
+                ENDIF
+             ENDDO
+
+             IF ( use_surface_fluxes )  THEN
+                k = nzb_diff_s_inner(j,i)-1
+
+                IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets )  THEN
+                   k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                   k2 = 0.61_wp * pt(k,j,i)
+                ELSE IF ( cloud_physics )  THEN
+                   IF ( ql(k,j,i) == 0.0_wp )  THEN
+                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                      k2 = 0.61_wp * pt(k,j,i)
+                   ELSE
+                      theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                      temp  = theta * t_d_pt(k)
+                      k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                 &
+                                    ( q(k,j,i) - ql(k,j,i) ) *          &
+                           ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
+                           ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
+                           ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                      k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                   ENDIF
+                ELSE IF ( cloud_droplets )  THEN
+                   k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                   k2 = 0.61_wp * pt(k,j,i)
+                ENDIF
+
+                tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
+                                            ( k1* shf(j,i) + k2 * qsws(j,i) )
+             ENDIF
+
+             IF ( use_top_fluxes )  THEN
+                k = nzt
+
+                IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets )  THEN
+                   k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                   k2 = 0.61_wp * pt(k,j,i)
+                ELSE IF ( cloud_physics )  THEN
+                   IF ( ql(k,j,i) == 0.0_wp )  THEN
+                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                      k2 = 0.61_wp * pt(k,j,i)
+                   ELSE
+                      theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                      temp  = theta * t_d_pt(k)
+                      k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                 &
+                                    ( q(k,j,i) - ql(k,j,i) ) *          &
+                           ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
+                           ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
+                           ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                      k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                   ENDIF
+                ELSE IF ( cloud_droplets )  THEN
+                   k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                   k2 = 0.61_wp * pt(k,j,i)
+                ENDIF
+
+                tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
+                                            ( k1* tswst(j,i) + k2 * qswst(j,i) )
+             ENDIF
+
+          ENDIF
+
+       ENDIF
+
+    END SUBROUTINE production_e_ij
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> @todo Missing subroutine description.
+!------------------------------------------------------------------------------!
+    SUBROUTINE production_e_init
+
+       USE arrays_3d,                                                          &
+           ONLY:  kh, km, u, us, usws, v, vsws, zu
+
+       USE control_parameters,                                                 &
+           ONLY:  constant_flux_layer, kappa
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb_u_inner,     &
+                  nzb_v_inner
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i   !<
+       INTEGER(iwp) ::  j   !<
+       INTEGER(iwp) ::  ku  !<
+       INTEGER(iwp) ::  kv  !<
+
+       IF ( constant_flux_layer )  THEN
+
+          IF ( first_call )  THEN
+             ALLOCATE( u_0(nysg:nyng,nxlg:nxrg), v_0(nysg:nyng,nxlg:nxrg) )
+             u_0 = 0.0_wp   ! just to avoid access of uninitialized memory
+             v_0 = 0.0_wp   ! within exchange_horiz_2d
+             first_call = .FALSE.
+          ENDIF
+
+!
+!--       Calculate a virtual velocity at the surface in a way that the
+!--       vertical velocity gradient at k = 1 (u(k+1)-u_0) matches the
+!--       Prandtl law (-w'u'/km). This gradient is used in the TKE shear
+!--       production term at k=1 (see production_e_ij).
+!--       The velocity gradient has to be limited in case of too small km
+!--       (otherwise the timestep may be significantly reduced by large
+!--       surface winds).
+!--       Upper bounds are nxr+1 and nyn+1 because otherwise these values are
+!--       not available in case of non-cyclic boundary conditions.
+!--       WARNING: the exact analytical solution would require the determination
+!--                of the eddy diffusivity by km = u* * kappa * zp / phi_m.
+          !$OMP PARALLEL DO PRIVATE( ku, kv )
+          DO  i = nxl, nxr+1
+             DO  j = nys, nyn+1
+
+                ku = nzb_u_inner(j,i)+1
+                kv = nzb_v_inner(j,i)+1
+
+                u_0(j,i) = u(ku+1,j,i) + usws(j,i) * ( zu(ku+1) - zu(ku-1) ) / &
+                                 ( 0.5_wp * ( km(ku,j,i) + km(ku,j,i-1) ) +    &
+                                   1.0E-20_wp )
+!                                  ( us(j,i) * kappa * zu(1) )
+                v_0(j,i) = v(kv+1,j,i) + vsws(j,i) * ( zu(kv+1) - zu(kv-1) ) / &
+                                 ( 0.5_wp * ( km(kv,j,i) + km(kv,j-1,i) ) +    &
+                                   1.0E-20_wp )
+!                                  ( us(j,i) * kappa * zu(1) )
+
+                IF ( ABS( u(ku+1,j,i) - u_0(j,i) )  > &
+                     ABS( u(ku+1,j,i) - u(ku-1,j,i) ) )  u_0(j,i) = u(ku-1,j,i)
+                IF ( ABS( v(kv+1,j,i) - v_0(j,i) )  > &
+                     ABS( v(kv+1,j,i) - v(kv-1,j,i) ) )  v_0(j,i) = v(kv-1,j,i)
+
+             ENDDO
+          ENDDO
+
+          CALL exchange_horiz_2d( u_0 )
+          CALL exchange_horiz_2d( v_0 )
+
+       ENDIF
+
+    END SUBROUTINE production_e_init
+
+ END MODULE production_e_mod
Index: lm/trunk/SOURCE/production_e_mod.f90
===================================================================
--- /palm/trunk/SOURCE/production_e_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,1998 +1,0 @@
-!> @file production_e_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1691 2015-10-26 16:17:44Z maronga
-! Renamed prandtl_layer to constant_flux_layer.
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1374 2014-04-25 12:55:07Z raasch
-! nzb_s_outer removed from acc-present-list
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-! 
-! 1342 2014-03-26 17:04:47Z kanani
-! REAL constants defined as wp-kind
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! old module precision_kind is removed,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1257 2013-11-08 15:18:40Z raasch
-! openacc loop and loop vector clauses removed, declare create moved after
-! the FORTRAN declaration statement
-!
-! 1179 2013-06-14 05:57:58Z raasch
-! use_reference renamed use_single_reference_value
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! accelerator version (*_acc) added
-!
-! 1007 2012-09-19 14:30:36Z franke
-! Bugfix: calculation of buoyancy production has to consider the liquid water
-! mixing ratio in case of cloud droplets
-!
-! 940 2012-07-09 14:31:00Z raasch
-! TKE production by buoyancy can be switched off in case of runs with pure
-! neutral stratification
-!
-! Revision 1.1  1997/09/19 07:45:35  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Production terms (shear + buoyancy) of the TKE.
-!> @warning The case with constant_flux_layer = F and use_surface_fluxes = T is
-!>          not considered well!
-!------------------------------------------------------------------------------!
- MODULE production_e_mod
- 
-
-    USE wall_fluxes_mod,                                                       &
-        ONLY:  wall_fluxes_e, wall_fluxes_e_acc
-
-    USE kinds
-
-    PRIVATE
-    PUBLIC production_e, production_e_acc, production_e_init
-
-    LOGICAL, SAVE ::  first_call = .TRUE.  !<
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  u_0  !<
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  v_0  !<
-
-    INTERFACE production_e
-       MODULE PROCEDURE production_e
-       MODULE PROCEDURE production_e_ij
-    END INTERFACE production_e
-    
-    INTERFACE production_e_acc
-       MODULE PROCEDURE production_e_acc
-    END INTERFACE production_e_acc
-
-    INTERFACE production_e_init
-       MODULE PROCEDURE production_e_init
-    END INTERFACE production_e_init
- 
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE production_e
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, dd2zu, kh, km, pt, q, ql, qsws, qswst, rho, shf,       &
-                  tend, tswst, u, v, vpt, w
-
-       USE cloud_parameters,                                                   &
-           ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
-
-       USE control_parameters,                                                 &
-           ONLY:  cloud_droplets, cloud_physics, constant_flux_layer, g,       &
-                  humidity, kappa, neutral, ocean, pt_reference,               &
-                  rho_reference, use_single_reference_value,                   &
-                  use_surface_fluxes, use_top_fluxes
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, dx, ddy, dy, wall_e_x, wall_e_y
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nys, nyn, nzb, nzb_diff_s_inner,                   &
-                   nzb_diff_s_outer, nzb_s_inner, nzt, nzt_diff
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i           !<
-       INTEGER(iwp) ::  j           !<
-       INTEGER(iwp) ::  k           !<
-
-       REAL(wp)     ::  def         !<
-       REAL(wp)     ::  dudx        !<
-       REAL(wp)     ::  dudy        !<
-       REAL(wp)     ::  dudz        !<
-       REAL(wp)     ::  dvdx        !<
-       REAL(wp)     ::  dvdy        !<
-       REAL(wp)     ::  dvdz        !<
-       REAL(wp)     ::  dwdx        !<
-       REAL(wp)     ::  dwdy        !<
-       REAL(wp)     ::  dwdz        !<
-       REAL(wp)     ::  k1          !<
-       REAL(wp)     ::  k2          !<
-       REAL(wp)     ::  km_neutral  !<
-       REAL(wp)     ::  theta       !<
-       REAL(wp)     ::  temp        !<
-
-!       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs, vsus, wsus, wsvs
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  usvs  !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  vsus  !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsus  !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsvs  !<
-
-!
-!--    First calculate horizontal momentum flux u'v', w'v', v'u', w'u' at
-!--    vertical walls, if neccessary
-!--    So far, results are slightly different from the ij-Version.
-!--    Therefore, ij-Version is called further below within the ij-loops.
-!       IF ( topography /= 'flat' )  THEN
-!          CALL wall_fluxes_e( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, wall_e_y )
-!          CALL wall_fluxes_e( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, wall_e_y )
-!          CALL wall_fluxes_e( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, wall_e_x )
-!          CALL wall_fluxes_e( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, wall_e_x )
-!       ENDIF
-
-
-       DO  i = nxl, nxr
-
-!
-!--       Calculate TKE production by shear
-          DO  j = nys, nyn
-             DO  k = nzb_diff_s_outer(j,i), nzt
-
-                dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-                dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                    u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                    u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
-
-                dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                    v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                    v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
-
-                dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                    w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                    w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-                def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                      dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                      dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                IF ( def < 0.0_wp )  def = 0.0_wp
-
-                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-             ENDDO
-          ENDDO
-
-          IF ( constant_flux_layer )  THEN
-
-!
-!--          Position beneath wall
-!--          (2) - Will allways be executed.
-!--          'bottom and wall: use u_0,v_0 and wall functions'
-             DO  j = nys, nyn
-
-                IF ( ( wall_e_x(j,i) /= 0.0_wp ) .OR. ( wall_e_y(j,i) /= 0.0_wp ) ) &
-                THEN
-
-                   k = nzb_diff_s_inner(j,i) - 1
-                   dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
-                   dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                     u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
-                   dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
-                   dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                     v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
-                   dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
-
-                   IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
-!
-!--                   Inconsistency removed: as the thermal stratification is 
-!--                   not taken into account for the evaluation of the wall 
-!--                   fluxes at vertical walls, the eddy viscosity km must not 
-!--                   be used for the evaluation of the velocity gradients dudy 
-!--                   and dwdy
-!--                   Note: The validity of the new method has not yet been 
-!--                         shown, as so far no suitable data for a validation 
-!--                         has been available
-                      CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
-                                          usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
-                      CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
-                                          wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
-                      km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25_wp * &
-                                   0.5_wp * dy 
-                      IF ( km_neutral > 0.0_wp )  THEN
-                         dudy = - wall_e_y(j,i) * usvs(k) / km_neutral
-                         dwdy = - wall_e_y(j,i) * wsvs(k) / km_neutral
-                      ELSE
-                         dudy = 0.0_wp
-                         dwdy = 0.0_wp
-                      ENDIF
-                   ELSE
-                      dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                         u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                      dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                         w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                   ENDIF
-
-                   IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
-!
-!--                   Inconsistency removed: as the thermal stratification is 
-!--                   not taken into account for the evaluation of the wall 
-!--                   fluxes at vertical walls, the eddy viscosity km must not 
-!--                   be used for the evaluation of the velocity gradients dvdx 
-!--                   and dwdx
-!--                   Note: The validity of the new method has not yet been 
-!--                         shown, as so far no suitable data for a validation 
-!--                         has been available
-                      CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
-                                          vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
-                      CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
-                                          wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
-                      km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25_wp * &
-                                   0.5_wp * dx
-                      IF ( km_neutral > 0.0_wp )  THEN
-                         dvdx = - wall_e_x(j,i) * vsus(k) / km_neutral
-                         dwdx = - wall_e_x(j,i) * wsus(k) / km_neutral
-                      ELSE
-                         dvdx = 0.0_wp
-                         dwdx = 0.0_wp
-                      ENDIF
-                   ELSE
-                      dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                         v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                      dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                         w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                   ENDIF
-
-                   def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                         dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                         dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                   IF ( def < 0.0_wp )  def = 0.0_wp
-
-                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-
-!
-!--                (3) - will be executed only, if there is at least one level
-!--                between (2) and (4), i.e. the topography must have a
-!--                minimum height of 2 dz. Wall fluxes for this case have
-!--                already been calculated for (2).
-!--                'wall only: use wall functions'
-
-                   DO  k = nzb_diff_s_inner(j,i), nzb_diff_s_outer(j,i)-2
-
-                      dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
-                      dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                        u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
-                      dvdy =          ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                      dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                        v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
-                      dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
-
-                      IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
-!
-!--                      Inconsistency removed: as the thermal stratification 
-!--                      is not taken into account for the evaluation of the 
-!--                      wall fluxes at vertical walls, the eddy viscosity km 
-!--                      must not be used for the evaluation of the velocity 
-!--                      gradients dudy and dwdy
-!--                      Note: The validity of the new method has not yet 
-!--                            been shown, as so far no suitable data for a 
-!--                            validation has been available
-                         km_neutral = kappa * ( usvs(k)**2 + & 
-                                                wsvs(k)**2 )**0.25_wp * 0.5_wp * dy
-                         IF ( km_neutral > 0.0_wp )  THEN
-                            dudy = - wall_e_y(j,i) * usvs(k) / km_neutral
-                            dwdy = - wall_e_y(j,i) * wsvs(k) / km_neutral
-                         ELSE
-                            dudy = 0.0_wp
-                            dwdy = 0.0_wp
-                         ENDIF
-                      ELSE
-                         dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                            u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                         dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                            w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                      ENDIF
-
-                      IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
-!
-!--                      Inconsistency removed: as the thermal stratification 
-!--                      is not taken into account for the evaluation of the 
-!--                      wall fluxes at vertical walls, the eddy viscosity km 
-!--                      must not be used for the evaluation of the velocity 
-!--                      gradients dvdx and dwdx
-!--                      Note: The validity of the new method has not yet 
-!--                            been shown, as so far no suitable data for a 
-!--                            validation has been available
-                         km_neutral = kappa * ( vsus(k)**2 + & 
-                                                wsus(k)**2 )**0.25_wp * 0.5_wp * dx
-                         IF ( km_neutral > 0.0_wp )  THEN
-                            dvdx = - wall_e_x(j,i) * vsus(k) / km_neutral
-                            dwdx = - wall_e_x(j,i) * wsus(k) / km_neutral
-                         ELSE
-                            dvdx = 0.0_wp
-                            dwdx = 0.0_wp
-                         ENDIF
-                      ELSE
-                         dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                            v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                         dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                            w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                      ENDIF
-
-                      def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                           dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 +  &
-                           dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                      IF ( def < 0.0_wp )  def = 0.0_wp
-
-                      tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-                   ENDDO
-
-                ENDIF
-
-             ENDDO
-
-!
-!--          (4) - will allways be executed.
-!--          'special case: free atmosphere' (as for case (0))
-             DO  j = nys, nyn
-
-                IF ( ( wall_e_x(j,i) /= 0.0_wp ) .OR. ( wall_e_y(j,i) /= 0.0_wp ) ) &
-                THEN
-
-                   k = nzb_diff_s_outer(j,i)-1
-
-                   dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-                   dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                       u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                   dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                       u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
-
-                   dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                       v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                   dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                   dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                       v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
-
-                   dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                       w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                   dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                       w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                   dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-                   def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                         dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                         dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                   IF ( def < 0.0_wp )  def = 0.0_wp
-
-                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-                ENDIF
-
-             ENDDO
-
-!
-!--          Position without adjacent wall
-!--          (1) - will allways be executed. 
-!--          'bottom only: use u_0,v_0'
-             DO  j = nys, nyn
-
-                IF ( ( wall_e_x(j,i) == 0.0_wp ) .AND. ( wall_e_y(j,i) == 0.0_wp ) ) &
-                THEN
-
-                   k = nzb_diff_s_inner(j,i)-1
-
-                   dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-                   dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                       u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                   dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                       u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
-
-                   dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                       v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                   dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                   dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                       v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
-
-                   dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                       w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                   dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                       w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                   dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-                   def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                         dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                         dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                   IF ( def < 0.0_wp )  def = 0.0_wp
-
-                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-                ENDIF
-
-             ENDDO
-
-          ELSEIF ( use_surface_fluxes )  THEN
-
-             DO  j = nys, nyn
-
-                k = nzb_diff_s_outer(j,i)-1
-
-                dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-                dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                    u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                   u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
-
-                dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                    v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                    v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
-
-                dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                    w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                    w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-                def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                      dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                      dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                IF ( def < 0.0_wp )  def = 0.0_wp
-
-                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-             ENDDO
-
-          ENDIF
-
-!
-!--       If required, calculate TKE production by buoyancy
-          IF ( .NOT. neutral )  THEN
-
-             IF ( .NOT. humidity )  THEN
-
-                IF ( use_single_reference_value )  THEN
-
-                   IF ( ocean )  THEN
-!
-!--                   So far in the ocean no special treatment of density flux
-!--                   in the bottom and top surface layer
-                      DO  j = nys, nyn
-                         DO  k = nzb_s_inner(j,i)+1, nzt
-                            tend(k,j,i) = tend(k,j,i) +                     &
-                                          kh(k,j,i) * g / rho_reference *   &
-                                          ( rho(k+1,j,i) - rho(k-1,j,i) ) * &
-                                          dd2zu(k)
-                         ENDDO
-                      ENDDO
-
-                   ELSE
-
-                      DO  j = nys, nyn
-                         DO  k = nzb_diff_s_inner(j,i), nzt_diff
-                            tend(k,j,i) = tend(k,j,i) -                   &
-                                          kh(k,j,i) * g / pt_reference *  &
-                                          ( pt(k+1,j,i) - pt(k-1,j,i) ) * &
-                                          dd2zu(k)
-                         ENDDO
-
-                         IF ( use_surface_fluxes )  THEN
-                            k = nzb_diff_s_inner(j,i)-1
-                            tend(k,j,i) = tend(k,j,i) + g / pt_reference * &
-                                                        shf(j,i)
-                         ENDIF
-
-                         IF ( use_top_fluxes )  THEN
-                            k = nzt
-                            tend(k,j,i) = tend(k,j,i) + g / pt_reference * &
-                                                        tswst(j,i)
-                         ENDIF
-                      ENDDO
-
-                   ENDIF
-
-                ELSE
-
-                   IF ( ocean )  THEN
-!
-!--                   So far in the ocean no special treatment of density flux
-!--                   in the bottom and top surface layer
-                      DO  j = nys, nyn
-                         DO  k = nzb_s_inner(j,i)+1, nzt
-                            tend(k,j,i) = tend(k,j,i) +                     &
-                                          kh(k,j,i) * g / rho(k,j,i) *      &
-                                          ( rho(k+1,j,i) - rho(k-1,j,i) ) * &
-                                          dd2zu(k)
-                         ENDDO
-                      ENDDO
-
-                   ELSE
-
-                      DO  j = nys, nyn
-                         DO  k = nzb_diff_s_inner(j,i), nzt_diff
-                            tend(k,j,i) = tend(k,j,i) -                   &
-                                          kh(k,j,i) * g / pt(k,j,i) *     &
-                                          ( pt(k+1,j,i) - pt(k-1,j,i) ) * &
-                                          dd2zu(k)
-                         ENDDO
-
-                         IF ( use_surface_fluxes )  THEN
-                            k = nzb_diff_s_inner(j,i)-1
-                            tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * &
-                                                        shf(j,i)
-                         ENDIF
-
-                         IF ( use_top_fluxes )  THEN
-                            k = nzt
-                            tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * &
-                                                        tswst(j,i)
-                         ENDIF
-                      ENDDO
-
-                   ENDIF
-
-                ENDIF
-
-             ELSE
-
-                DO  j = nys, nyn
-
-                   DO  k = nzb_diff_s_inner(j,i), nzt_diff
-
-                      IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                         k2 = 0.61_wp * pt(k,j,i)
-                         tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *               &
-                                         g / vpt(k,j,i) *                      &
-                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
-                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
-                                         ) * dd2zu(k)
-                      ELSE IF ( cloud_physics )  THEN
-                         IF ( ql(k,j,i) == 0.0_wp )  THEN
-                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                            k2 = 0.61_wp * pt(k,j,i)
-                         ELSE
-                            theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                            temp  = theta * t_d_pt(k)
-                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
-                                          ( q(k,j,i) - ql(k,j,i) ) *          &
-                                 ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
-                                 ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
-                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                            k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                         ENDIF
-                         tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *               &
-                                         g / vpt(k,j,i) *                      &
-                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
-                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
-                                         ) * dd2zu(k)
-                      ELSE IF ( cloud_droplets )  THEN
-                         k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                         k2 = 0.61_wp * pt(k,j,i)
-                         tend(k,j,i) = tend(k,j,i) -                          & 
-                                       kh(k,j,i) * g / vpt(k,j,i) *           &
-                                       ( k1 * ( pt(k+1,j,i)- pt(k-1,j,i) ) +  &
-                                         k2 * ( q(k+1,j,i) -  q(k-1,j,i) ) -  &
-                                         pt(k,j,i) * ( ql(k+1,j,i) -          &
-                                         ql(k-1,j,i) ) ) * dd2zu(k)
-                      ENDIF
-
-                   ENDDO
-
-                ENDDO
-
-                IF ( use_surface_fluxes )  THEN
-
-                   DO  j = nys, nyn
-
-                      k = nzb_diff_s_inner(j,i)-1
-
-                      IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                         k2 = 0.61_wp * pt(k,j,i)
-                      ELSE IF ( cloud_physics )  THEN
-                         IF ( ql(k,j,i) == 0.0_wp )  THEN
-                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                            k2 = 0.61_wp * pt(k,j,i)
-                         ELSE
-                            theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                            temp  = theta * t_d_pt(k)
-                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
-                                          ( q(k,j,i) - ql(k,j,i) ) *           &
-                                 ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /      &
-                                 ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *        &
-                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                            k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                         ENDIF
-                      ELSE IF ( cloud_droplets )  THEN
-                         k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                         k2 = 0.61_wp * pt(k,j,i)
-                      ENDIF
-
-                      tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
-                                            ( k1* shf(j,i) + k2 * qsws(j,i) )
-                   ENDDO
-
-                ENDIF
-
-                IF ( use_top_fluxes )  THEN
-
-                   DO  j = nys, nyn
-
-                      k = nzt
-
-                      IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                         k2 = 0.61_wp * pt(k,j,i)
-                      ELSE IF ( cloud_physics )  THEN
-                         IF ( ql(k,j,i) == 0.0_wp )  THEN
-                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                            k2 = 0.61_wp * pt(k,j,i)
-                         ELSE
-                            theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                            temp  = theta * t_d_pt(k)
-                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
-                                          ( q(k,j,i) - ql(k,j,i) ) *           &
-                                 ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /      &
-                                 ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *        &
-                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                            k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                         ENDIF
-                      ELSE IF ( cloud_droplets )  THEN
-                         k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                         k2 = 0.61_wp * pt(k,j,i)
-                      ENDIF
-
-                      tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
-                                            ( k1* tswst(j,i) + k2 * qswst(j,i) )
-                   ENDDO
-
-                ENDIF
-
-             ENDIF
-
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE production_e
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE production_e_acc
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, dd2zu, kh, km, pt, q, ql, qsws, qswst, rho, shf,       &
-                  tend, tswst, u, v, vpt, w
-
-       USE cloud_parameters,                                                   &
-           ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
-
-       USE control_parameters,                                                 &
-           ONLY:  cloud_droplets, cloud_physics, constant_flux_layer, g,       &
-                  humidity, kappa, neutral, ocean, pt_reference,               &
-                  rho_reference, topography, use_single_reference_value,       &
-                  use_surface_fluxes, use_top_fluxes
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, dx, ddy, dy, wall_e_x, wall_e_y
-
-       USE indices,                                                            &
-           ONLY:  i_left, i_right, j_north, j_south, nxl, nxr, nys, nyn, nzb,  &
-                  nzb_diff_s_inner, nzb_diff_s_outer, nzb_s_inner, nzt,        &
-                  nzt_diff
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i           !<
-       INTEGER(iwp) ::  j           !<
-       INTEGER(iwp) ::  k           !<
-
-       REAL(wp)     ::  def         !<
-       REAL(wp)     ::  dudx        !<
-       REAL(wp)     ::  dudy        !<
-       REAL(wp)     ::  dudz        !<
-       REAL(wp)     ::  dvdx        !<
-       REAL(wp)     ::  dvdy        !<
-       REAL(wp)     ::  dvdz        !<
-       REAL(wp)     ::  dwdx        !<
-       REAL(wp)     ::  dwdy        !<
-       REAL(wp)     ::  dwdz        !<
-       REAL(wp)     ::  k1          !<
-       REAL(wp)     ::  k2          !<
-       REAL(wp)     ::  km_neutral  !<
-       REAL(wp)     ::  theta       !<
-       REAL(wp)     ::  temp        !<
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  usvs  !<
-       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  vsus  !<
-       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus  !<
-       REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsvs  !<
-       !$acc declare create ( usvs, vsus, wsus, wsvs )
-
-!
-!--    First calculate horizontal momentum flux u'v', w'v', v'u', w'u' at
-!--    vertical walls, if neccessary
-!--    CAUTION: results are slightly different from the ij-version!!
-!--    ij-version should be called further below within the ij-loops!!
-       IF ( topography /= 'flat' )  THEN
-          CALL wall_fluxes_e_acc( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, wall_e_y )
-          CALL wall_fluxes_e_acc( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, wall_e_y )
-          CALL wall_fluxes_e_acc( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, wall_e_x )
-          CALL wall_fluxes_e_acc( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, wall_e_x )
-       ENDIF
-
-
-!
-!--    Calculate TKE production by shear
-       !$acc kernels present( ddzw, dd2zu, kh, km, nzb_diff_s_inner, nzb_diff_s_outer ) &
-       !$acc         present( nzb_s_inner, pt, q, ql, qsws, qswst, rho )                &
-       !$acc         present( shf, tend, tswst, u, v, vpt, w, wall_e_x, wall_e_y )      &
-       !$acc         copyin( u_0, v_0 )
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-             DO  k = 1, nzt
-
-                IF ( k >= nzb_diff_s_outer(j,i) )  THEN
-
-                   dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-                   dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                       u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                   dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                       u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
-
-                   dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                       v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                   dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                   dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                       v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
-
-                   dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                       w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                   dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                       w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                   dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-                   def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                         dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                         dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                   IF ( def < 0.0_wp )  def = 0.0_wp
-
-                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-       IF ( constant_flux_layer )  THEN
-
-!
-!--       Position beneath wall
-!--       (2) - Will allways be executed.
-!--       'bottom and wall: use u_0,v_0 and wall functions'
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-                DO  k = 1, nzt
-
-                   IF ( ( wall_e_x(j,i) /= 0.0_wp ).OR.( wall_e_y(j,i) /= 0.0_wp ) ) &
-                   THEN
-
-                      IF ( k == nzb_diff_s_inner(j,i) - 1 )  THEN
-                         dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
-                         dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                           u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
-                         dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
-                         dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                           v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
-                         dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
-
-                         IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
-!
-!--                         Inconsistency removed: as the thermal stratification is
-!--                         not taken into account for the evaluation of the wall
-!--                         fluxes at vertical walls, the eddy viscosity km must not
-!--                         be used for the evaluation of the velocity gradients dudy
-!--                         and dwdy
-!--                         Note: The validity of the new method has not yet been
-!--                               shown, as so far no suitable data for a validation
-!--                               has been available
-!                            CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
-!                                                usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
-!                            CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
-!                                                wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
-                            km_neutral = kappa *                                    &
-                                        ( usvs(k,j,i)**2 + wsvs(k,j,i)**2 )**0.25_wp * &
-                                         0.5_wp * dy
-                            IF ( km_neutral > 0.0_wp )  THEN
-                               dudy = - wall_e_y(j,i) * usvs(k,j,i) / km_neutral
-                               dwdy = - wall_e_y(j,i) * wsvs(k,j,i) / km_neutral
-                            ELSE
-                               dudy = 0.0_wp
-                               dwdy = 0.0_wp
-                            ENDIF
-                         ELSE
-                            dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                               u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                            dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                               w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                         ENDIF
-
-                         IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
-!
-!--                         Inconsistency removed: as the thermal stratification is
-!--                         not taken into account for the evaluation of the wall
-!--                         fluxes at vertical walls, the eddy viscosity km must not
-!--                         be used for the evaluation of the velocity gradients dvdx
-!--                         and dwdx
-!--                         Note: The validity of the new method has not yet been
-!--                               shown, as so far no suitable data for a validation
-!--                               has been available
-!                            CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
-!                                                vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
-!                            CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
-!                                                wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
-                            km_neutral = kappa *                                     &
-                                         ( vsus(k,j,i)**2 + wsus(k,j,i)**2 )**0.25_wp * &
-                                         0.5_wp * dx
-                            IF ( km_neutral > 0.0_wp )  THEN
-                               dvdx = - wall_e_x(j,i) * vsus(k,j,i) / km_neutral
-                               dwdx = - wall_e_x(j,i) * wsus(k,j,i) / km_neutral
-                            ELSE
-                               dvdx = 0.0_wp
-                               dwdx = 0.0_wp
-                            ENDIF
-                         ELSE
-                            dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                               v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                            dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                               w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                         ENDIF
-
-                         def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                               dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                               dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                         IF ( def < 0.0_wp )  def = 0.0_wp
-
-                         tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-                      ENDIF
-!
-!--                   (3) - will be executed only, if there is at least one level
-!--                   between (2) and (4), i.e. the topography must have a
-!--                   minimum height of 2 dz. Wall fluxes for this case have
-!--                   already been calculated for (2).
-!--                   'wall only: use wall functions'
-
-                      IF ( k >= nzb_diff_s_inner(j,i)  .AND.  &
-                           k <= nzb_diff_s_outer(j,i)-2 )  THEN
-
-                         dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
-                         dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                           u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
-                         dvdy =          ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                         dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                           v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
-                         dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
-
-                         IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
-!
-!--                         Inconsistency removed: as the thermal stratification
-!--                         is not taken into account for the evaluation of the
-!--                         wall fluxes at vertical walls, the eddy viscosity km
-!--                         must not be used for the evaluation of the velocity
-!--                         gradients dudy and dwdy
-!--                         Note: The validity of the new method has not yet
-!--                               been shown, as so far no suitable data for a
-!--                               validation has been available
-                            km_neutral = kappa * ( usvs(k,j,i)**2 + &
-                                                   wsvs(k,j,i)**2 )**0.25_wp * 0.5_wp * dy
-                            IF ( km_neutral > 0.0_wp )  THEN
-                               dudy = - wall_e_y(j,i) * usvs(k,j,i) / km_neutral
-                               dwdy = - wall_e_y(j,i) * wsvs(k,j,i) / km_neutral
-                            ELSE
-                               dudy = 0.0_wp
-                               dwdy = 0.0_wp
-                            ENDIF
-                         ELSE
-                            dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                               u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                            dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                               w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                         ENDIF
-
-                         IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
-!
-!--                         Inconsistency removed: as the thermal stratification
-!--                         is not taken into account for the evaluation of the
-!--                         wall fluxes at vertical walls, the eddy viscosity km
-!--                         must not be used for the evaluation of the velocity
-!--                         gradients dvdx and dwdx
-!--                         Note: The validity of the new method has not yet
-!--                               been shown, as so far no suitable data for a
-!--                               validation has been available
-                            km_neutral = kappa * ( vsus(k,j,i)**2 + &
-                                                   wsus(k,j,i)**2 )**0.25_wp * 0.5_wp * dx
-                            IF ( km_neutral > 0.0_wp )  THEN
-                               dvdx = - wall_e_x(j,i) * vsus(k,j,i) / km_neutral
-                               dwdx = - wall_e_x(j,i) * wsus(k,j,i) / km_neutral
-                            ELSE
-                               dvdx = 0.0_wp
-                               dwdx = 0.0_wp
-                            ENDIF
-                         ELSE
-                            dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                               v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                            dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                               w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                         ENDIF
-
-                         def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                              dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 +  &
-                              dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                         IF ( def < 0.0_wp )  def = 0.0_wp
-
-                         tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-                      ENDIF
-
-!
-!--                   (4) - will allways be executed.
-!--                   'special case: free atmosphere' (as for case (0))
-                      IF ( k == nzb_diff_s_outer(j,i)-1 )  THEN
-
-                         dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-                         dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                             u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                         dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                             u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
-
-                         dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                             v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                         dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                         dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                             v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
-
-                         dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                             w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                         dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                             w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                         dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-                         def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                               dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                               dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                         IF ( def < 0.0_wp )  def = 0.0_wp
-
-                         tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-                      ENDIF
-
-                   ENDIF
-
-                ENDDO
-             ENDDO
-          ENDDO
-
-!
-!--       Position without adjacent wall
-!--       (1) - will allways be executed.
-!--       'bottom only: use u_0,v_0'
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-                DO  k = 1, nzt
-
-                   IF ( ( wall_e_x(j,i) == 0.0_wp ) .AND. ( wall_e_y(j,i) == 0.0_wp ) ) &
-                   THEN
-
-                      IF ( k == nzb_diff_s_inner(j,i)-1 )  THEN
-
-                         dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-                         dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                             u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                         dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                             u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
-
-                         dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                             v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                         dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                         dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                             v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
-
-                         dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                             w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                         dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                             w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                         dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-                         def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                               dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                               dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                         IF ( def < 0.0_wp )  def = 0.0_wp
-
-                         tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-                      ENDIF
-
-                   ENDIF
-
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ELSEIF ( use_surface_fluxes )  THEN
-
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-                 DO  k = 1, nzt
-
-                   IF ( k == nzb_diff_s_outer(j,i)-1 )  THEN
-
-                      dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-                      dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                          u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                      dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                          u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
-
-                      dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                          v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                      dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                      dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                          v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
-
-                      dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                          w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                      dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                          w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                      dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-                      def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                            dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                            dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                      IF ( def < 0.0_wp )  def = 0.0_wp
-
-                      tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-                   ENDIF
-
-                ENDDO
-             ENDDO
-          ENDDO
-
-       ENDIF
-
-!
-!--    If required, calculate TKE production by buoyancy
-       IF ( .NOT. neutral )  THEN
-
-          IF ( .NOT. humidity )  THEN
-
-             IF ( use_single_reference_value )  THEN
-
-                IF ( ocean )  THEN
-!
-!--                So far in the ocean no special treatment of density flux
-!--                in the bottom and top surface layer
-                   DO  i = i_left, i_right
-                      DO  j = j_south, j_north
-                         DO  k = 1, nzt
-                            IF ( k > nzb_s_inner(j,i) )  THEN
-                               tend(k,j,i) = tend(k,j,i) +                     &
-                                             kh(k,j,i) * g / rho_reference *   &
-                                             ( rho(k+1,j,i) - rho(k-1,j,i) ) * &
-                                             dd2zu(k)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                ELSE
-
-                   DO  i = i_left, i_right
-                      DO  j = j_south, j_north
-                         DO  k = 1, nzt_diff
-                            IF ( k >= nzb_diff_s_inner(j,i) )  THEN
-                               tend(k,j,i) = tend(k,j,i) -                   &
-                                             kh(k,j,i) * g / pt_reference *  &
-                                             ( pt(k+1,j,i) - pt(k-1,j,i) ) * &
-                                             dd2zu(k)
-                            ENDIF
-
-                            IF ( k == nzb_diff_s_inner(j,i)-1  .AND.  &
-                                 use_surface_fluxes )  THEN
-                               tend(k,j,i) = tend(k,j,i) + g / pt_reference * &
-                                                           shf(j,i)
-                            ENDIF
-
-                            IF ( k == nzt  .AND.  use_top_fluxes )  THEN
-                               tend(k,j,i) = tend(k,j,i) + g / pt_reference * &
-                                                           tswst(j,i)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                ENDIF
-
-             ELSE
-
-                IF ( ocean )  THEN
-!
-!--                So far in the ocean no special treatment of density flux
-!--                in the bottom and top surface layer
-                   DO  i = i_left, i_right
-                      DO  j = j_south, j_north
-                         DO  k = 1, nzt
-                            IF ( k > nzb_s_inner(j,i) )  THEN
-                               tend(k,j,i) = tend(k,j,i) +                     &
-                                             kh(k,j,i) * g / rho(k,j,i) *      &
-                                             ( rho(k+1,j,i) - rho(k-1,j,i) ) * &
-                                             dd2zu(k)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                ELSE
-
-                   DO  i = i_left, i_right
-                      DO  j = j_south, j_north
-                         DO  k = 1, nzt_diff
-                            IF( k >= nzb_diff_s_inner(j,i) )  THEN
-                               tend(k,j,i) = tend(k,j,i) -                   &
-                                             kh(k,j,i) * g / pt(k,j,i) *     &
-                                             ( pt(k+1,j,i) - pt(k-1,j,i) ) * &
-                                             dd2zu(k)
-                            ENDIF
-
-                            IF (  k == nzb_diff_s_inner(j,i)-1  .AND.  &
-                                  use_surface_fluxes )  THEN
-                               tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * &
-                                                           shf(j,i)
-                            ENDIF
-
-                            IF ( k == nzt  .AND.  use_top_fluxes )  THEN
-                               tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * &
-                                                           tswst(j,i)
-                            ENDIF
-                         ENDDO
-                      ENDDO
-                   ENDDO
-
-                ENDIF
-
-             ENDIF
-
-          ELSE
-!
-!++          This part gives the PGI compiler problems in the previous loop
-!++          even without any acc statements????
-!             STOP '+++ production_e problems with acc-directives'
-!             !acc loop
-!             DO  i = nxl, nxr
-!                DO  j = nys, nyn
-!                   !acc loop vector
-!                   DO  k = 1, nzt_diff
-!
-!                      IF ( k >= nzb_diff_s_inner(j,i) )  THEN
-!
-!                         IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-!                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-!                            k2 = 0.61_wp * pt(k,j,i)
-!                            tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *               &
-!                                            g / vpt(k,j,i) *                      &
-!                                            ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
-!                                              k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
-!                                            ) * dd2zu(k)
-!                         ELSE IF ( cloud_physics )  THEN
-!                            IF ( ql(k,j,i) == 0.0_wp )  THEN
-!                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-!                               k2 = 0.61_wp * pt(k,j,i)
-!                            ELSE
-!                               theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-!                               temp  = theta * t_d_pt(k)
-!                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                 &
-!                                             ( q(k,j,i) - ql(k,j,i) ) *          &
-!                                    ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
-!                                    ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
-!                                    ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-!                               k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-!                            ENDIF
-!                            tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *               &
-!                                            g / vpt(k,j,i) *                      &
-!                                            ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
-!                                              k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
-!                                            ) * dd2zu(k)
-!                         ELSE IF ( cloud_droplets )  THEN
-!                            k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-!                            k2 = 0.61_wp * pt(k,j,i)
-!                            tend(k,j,i) = tend(k,j,i) -                          &
-!                                          kh(k,j,i) * g / vpt(k,j,i) *           &
-!                                          ( k1 * ( pt(k+1,j,i)- pt(k-1,j,i) ) +  &
-!                                            k2 * ( q(k+1,j,i) -  q(k-1,j,i) ) -  &
-!                                            pt(k,j,i) * ( ql(k+1,j,i) -          &
-!                                            ql(k-1,j,i) ) ) * dd2zu(k)
-!                         ENDIF
-!
-!                      ENDIF
-!
-!                   ENDDO
-!                ENDDO
-!             ENDDO
-!
-
-!!++          Next two loops are probably very inefficiently parallellized
-!!++          and will require better optimization
-!             IF ( use_surface_fluxes )  THEN
-!
-!                !acc loop
-!                DO  i = nxl, nxr
-!                   DO  j = nys, nyn
-!                      !acc loop vector
-!                      DO  k = 1, nzt_diff
-!
-!                         IF ( k == nzb_diff_s_inner(j,i)-1 )  THEN
-!
-!                            IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-!                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-!                               k2 = 0.61_wp * pt(k,j,i)
-!                            ELSE IF ( cloud_physics )  THEN
-!                               IF ( ql(k,j,i) == 0.0_wp )  THEN
-!                                  k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-!                                  k2 = 0.61_wp * pt(k,j,i)
-!                               ELSE
-!                                  theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-!                                  temp  = theta * t_d_pt(k)
-!                                  k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *        &
-!                                                ( q(k,j,i) - ql(k,j,i) ) *    &
-!                                       ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /&
-!                                       ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp * &
-!                                       ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-!                                  k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-!                               ENDIF
-!                            ELSE IF ( cloud_droplets )  THEN
-!                               k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-!                               k2 = 0.61_wp * pt(k,j,i)
-!                            ENDIF
-!
-!                            tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
-!                                                  ( k1* shf(j,i) + k2 * qsws(j,i) )
-!                         ENDIF
-!
-!                      ENDDO
-!                   ENDDO
-!                ENDDO
-!
-!             ENDIF
-!
-!             IF ( use_top_fluxes )  THEN
-!
-!                !acc loop
-!                DO  i = nxl, nxr
-!                   DO  j = nys, nyn
-!                      !acc loop vector
-!                      DO  k = 1, nzt
-!                         IF ( k == nzt )  THEN
-!
-!                            IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-!                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-!                               k2 = 0.61_wp * pt(k,j,i)
-!                            ELSE IF ( cloud_physics )  THEN
-!                               IF ( ql(k,j,i) == 0.0_wp )  THEN
-!                                  k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-!                                  k2 = 0.61_wp * pt(k,j,i)
-!                               ELSE
-!                                  theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-!                                  temp  = theta * t_d_pt(k)
-!                                  k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *        &
-!                                                ( q(k,j,i) - ql(k,j,i) ) *    &
-!                                       ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /&
-!                                       ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp * &
-!                                       ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-!                                  k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-!                               ENDIF
-!                            ELSE IF ( cloud_droplets )  THEN
-!                               k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-!                               k2 = 0.61_wp * pt(k,j,i)
-!                            ENDIF
-!
-!                            tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
-!                                                  ( k1* tswst(j,i) + k2 * qswst(j,i) )
-!
-!                         ENDIF
-!
-!                      ENDDO
-!                   ENDDO
-!                ENDDO
-!
-!             ENDIF
-
-          ENDIF
-
-       ENDIF
-       !$acc end kernels
-
-    END SUBROUTINE production_e_acc
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE production_e_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, dd2zu, kh, km, pt, q, ql, qsws, qswst, rho, shf,       &
-                  tend, tswst, u, v, vpt, w
-
-       USE cloud_parameters,                                                   &
-           ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
-
-       USE control_parameters,                                                 &
-           ONLY:  cloud_droplets, cloud_physics, constant_flux_layer, g,       &
-                  humidity, kappa, neutral, ocean, pt_reference,               &
-                  rho_reference, use_single_reference_value,                   &
-                  use_surface_fluxes, use_top_fluxes
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, dx, ddy, dy, wall_e_x, wall_e_y
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nys, nyn, nzb, nzb_diff_s_inner,                   &
-                  nzb_diff_s_outer, nzb_s_inner, nzt, nzt_diff
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i           !<
-       INTEGER(iwp) ::  j           !<
-       INTEGER(iwp) ::  k           !<
-
-       REAL(wp)     ::  def         !<
-       REAL(wp)     ::  dudx        !<
-       REAL(wp)     ::  dudy        !<
-       REAL(wp)     ::  dudz        !<
-       REAL(wp)     ::  dvdx        !<
-       REAL(wp)     ::  dvdy        !<
-       REAL(wp)     ::  dvdz        !<
-       REAL(wp)     ::  dwdx        !<
-       REAL(wp)     ::  dwdy        !<
-       REAL(wp)     ::  dwdz        !<
-       REAL(wp)     ::  k1          !<
-       REAL(wp)     ::  k2          !<
-       REAL(wp)     ::  km_neutral  !<
-       REAL(wp)     ::  theta       !<
-       REAL(wp)     ::  temp        !<
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  usvs  !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  vsus  !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsus  !<
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  wsvs  !<
-
-!
-!--    Calculate TKE production by shear
-       DO  k = nzb_diff_s_outer(j,i), nzt
-
-          dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-          dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                              u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-          dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                              u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
-
-          dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                              v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-          dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-          dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                              v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
-
-          dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                              w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-          dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                              w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-          dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-          def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 )                       &
-                + dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + dvdz**2    &
-                + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-          IF ( def < 0.0_wp )  def = 0.0_wp
-
-          tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-       ENDDO
-
-       IF ( constant_flux_layer )  THEN
-
-          IF ( ( wall_e_x(j,i) /= 0.0_wp ) .OR. ( wall_e_y(j,i) /= 0.0_wp ) )  THEN
-
-!
-!--          Position beneath wall
-!--          (2) - Will allways be executed.
-!--          'bottom and wall: use u_0,v_0 and wall functions'
-             k = nzb_diff_s_inner(j,i)-1
-
-             dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
-             dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                               u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
-             dvdy =          ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-             dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                               v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
-             dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
-
-             IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
-!
-!--             Inconsistency removed: as the thermal stratification 
-!--             is not taken into account for the evaluation of the 
-!--             wall fluxes at vertical walls, the eddy viscosity km 
-!--             must not be used for the evaluation of the velocity 
-!--             gradients dudy and dwdy
-!--             Note: The validity of the new method has not yet 
-!--                   been shown, as so far no suitable data for a 
-!--                   validation has been available
-                CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
-                                    usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp )
-                CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
-                                    wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp )
-                km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25_wp * &
-                             0.5_wp * dy
-                IF ( km_neutral > 0.0_wp )  THEN
-                   dudy = - wall_e_y(j,i) * usvs(k) / km_neutral
-                   dwdy = - wall_e_y(j,i) * wsvs(k) / km_neutral
-                ELSE
-                   dudy = 0.0_wp
-                   dwdy = 0.0_wp
-                ENDIF
-             ELSE
-                dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                   u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                   w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-             ENDIF
-
-             IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
-!
-!--             Inconsistency removed: as the thermal stratification 
-!--             is not taken into account for the evaluation of the 
-!--             wall fluxes at vertical walls, the eddy viscosity km 
-!--             must not be used for the evaluation of the velocity 
-!--             gradients dvdx and dwdx
-!--             Note: The validity of the new method has not yet 
-!--                   been shown, as so far no suitable data for a 
-!--                   validation has been available
-                CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
-                                    vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp )
-                CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
-                                    wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp )
-                km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25_wp * & 
-                             0.5_wp * dx
-                IF ( km_neutral > 0.0_wp )  THEN
-                   dvdx = - wall_e_x(j,i) * vsus(k) / km_neutral
-                   dwdx = - wall_e_x(j,i) * wsus(k) / km_neutral
-                ELSE
-                   dvdx = 0.0_wp
-                   dwdx = 0.0_wp
-                ENDIF
-             ELSE
-                dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                   v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                   w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-             ENDIF
-
-             def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                   dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                   dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-             IF ( def < 0.0_wp )  def = 0.0_wp
-
-             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-!
-!--          (3) - will be executed only, if there is at least one level
-!--          between (2) and (4), i.e. the topography must have a
-!--          minimum height of 2 dz. Wall fluxes for this case have
-!--          already been calculated for (2).
-!--          'wall only: use wall functions'
-             DO  k = nzb_diff_s_inner(j,i), nzb_diff_s_outer(j,i)-2
-
-                dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
-                dudz = 0.5_wp * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                  u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
-                dvdy =          ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                dvdz = 0.5_wp * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                  v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
-                dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
-
-                IF ( wall_e_y(j,i) /= 0.0_wp )  THEN
-!
-!--                Inconsistency removed: as the thermal stratification 
-!--                is not taken into account for the evaluation of the 
-!--                wall fluxes at vertical walls, the eddy viscosity km 
-!--                must not be used for the evaluation of the velocity 
-!--                gradients dudy and dwdy
-!--                Note: The validity of the new method has not yet 
-!--                      been shown, as so far no suitable data for a 
-!--                      validation has been available
-                   km_neutral = kappa * ( usvs(k)**2 + & 
-                                          wsvs(k)**2 )**0.25_wp * 0.5_wp * dy
-                   IF ( km_neutral > 0.0_wp )  THEN
-                      dudy = - wall_e_y(j,i) * usvs(k) / km_neutral
-                      dwdy = - wall_e_y(j,i) * wsvs(k) / km_neutral
-                   ELSE
-                      dudy = 0.0_wp
-                      dwdy = 0.0_wp
-                   ENDIF
-                ELSE
-                   dudy = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                      u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-                   dwdy = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                      w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-                ENDIF
-
-                IF ( wall_e_x(j,i) /= 0.0_wp )  THEN
-!
-!--                Inconsistency removed: as the thermal stratification 
-!--                is not taken into account for the evaluation of the 
-!--                wall fluxes at vertical walls, the eddy viscosity km 
-!--                must not be used for the evaluation of the velocity 
-!--                gradients dvdx and dwdx
-!--                Note: The validity of the new method has not yet 
-!--                      been shown, as so far no suitable data for a 
-!--                      validation has been available
-                   km_neutral = kappa * ( vsus(k)**2 + & 
-                                          wsus(k)**2 )**0.25_wp * 0.5_wp * dx
-                   IF ( km_neutral > 0.0_wp )  THEN
-                      dvdx = - wall_e_x(j,i) * vsus(k) / km_neutral
-                      dwdx = - wall_e_x(j,i) * wsus(k) / km_neutral
-                   ELSE
-                      dvdx = 0.0_wp
-                      dwdx = 0.0_wp
-                   ENDIF
-                ELSE
-                   dvdx = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                      v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-                   dwdx = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                      w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-                ENDIF
-
-                def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                      dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                      dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-                IF ( def < 0.0_wp )  def = 0.0_wp
-
-                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-             ENDDO
-
-!
-!--          (4) - will allways be executed.
-!--          'special case: free atmosphere' (as for case (0))
-             k = nzb_diff_s_outer(j,i)-1
-
-             dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-             dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                 u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-             dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                 u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
-
-             dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                 v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-             dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-             dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                 v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
-
-             dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                 w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-             dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                 w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-             dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-             def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +        &
-                   dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                   dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-             IF ( def < 0.0_wp )  def = 0.0_wp
-
-             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-          ELSE
-
-!
-!--          Position without adjacent wall
-!--          (1) - will allways be executed. 
-!--          'bottom only: use u_0,v_0'
-             k = nzb_diff_s_inner(j,i)-1
-
-             dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-             dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                                 u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-             dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                                 u_0(j,i)   - u_0(j,i+1)   ) * dd2zu(k)
-
-             dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                                 v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-             dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-             dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                                 v_0(j,i)   - v_0(j+1,i)   ) * dd2zu(k)
-
-             dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                                 w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-             dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                                 w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-             dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-             def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 )                       &
-                   + dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + dvdz**2 &
-                   + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-             IF ( def < 0.0_wp )  def = 0.0_wp
-
-             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-          ENDIF
-
-       ELSEIF ( use_surface_fluxes )  THEN
-
-          k = nzb_diff_s_outer(j,i)-1
-
-          dudx  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-          dudy  = 0.25_wp * ( u(k,j+1,i) + u(k,j+1,i+1) - &
-                              u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
-          dudz  = 0.5_wp  * ( u(k+1,j,i) + u(k+1,j,i+1) - &
-                              u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
-
-          dvdx  = 0.25_wp * ( v(k,j,i+1) + v(k,j+1,i+1) - &
-                              v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
-          dvdy  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-          dvdz  = 0.5_wp  * ( v(k+1,j,i) + v(k+1,j+1,i) - &
-                              v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
-
-          dwdx  = 0.25_wp * ( w(k,j,i+1) + w(k-1,j,i+1) - &
-                              w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
-          dwdy  = 0.25_wp * ( w(k,j+1,i) + w(k-1,j+1,i) - &
-                              w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
-          dwdz  =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-          def = 2.0_wp * ( dudx**2 + dvdy**2 + dwdz**2 ) +           &
-                dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
-                dvdz**2 + 2.0_wp * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
-
-          IF ( def < 0.0_wp )  def = 0.0_wp
-
-          tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
-
-       ENDIF
-
-!
-!--    If required, calculate TKE production by buoyancy
-       IF ( .NOT. neutral )  THEN
-
-          IF ( .NOT. humidity )  THEN
-
-             IF ( use_single_reference_value )  THEN
-
-                IF ( ocean )  THEN
-!
-!--                So far in the ocean no special treatment of density flux in
-!--                the bottom and top surface layer
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tend(k,j,i) = tend(k,j,i) +                   &
-                                    kh(k,j,i) * g / rho_reference * &
-                                    ( rho(k+1,j,i) - rho(k-1,j,i) ) * dd2zu(k)
-                   ENDDO
-
-                ELSE
-
-                   DO  k = nzb_diff_s_inner(j,i), nzt_diff
-                      tend(k,j,i) = tend(k,j,i) -                  &
-                                    kh(k,j,i) * g / pt_reference * &
-                                    ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k)
-                   ENDDO
-
-                   IF ( use_surface_fluxes )  THEN
-                      k = nzb_diff_s_inner(j,i)-1
-                      tend(k,j,i) = tend(k,j,i) + g / pt_reference * shf(j,i)
-                   ENDIF
-
-                   IF ( use_top_fluxes )  THEN
-                      k = nzt
-                      tend(k,j,i) = tend(k,j,i) + g / pt_reference * tswst(j,i)
-                   ENDIF
-
-                ENDIF
-
-             ELSE
-
-                IF ( ocean )  THEN
-!
-!--                So far in the ocean no special treatment of density flux in
-!--                the bottom and top surface layer
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tend(k,j,i) = tend(k,j,i) +                &
-                                    kh(k,j,i) * g / rho(k,j,i) * &
-                                    ( rho(k+1,j,i) - rho(k-1,j,i) ) * dd2zu(k)
-                   ENDDO
-
-                ELSE
-
-                   DO  k = nzb_diff_s_inner(j,i), nzt_diff
-                      tend(k,j,i) = tend(k,j,i) -               &
-                                    kh(k,j,i) * g / pt(k,j,i) * &
-                                    ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k)
-                   ENDDO
-
-                   IF ( use_surface_fluxes )  THEN
-                      k = nzb_diff_s_inner(j,i)-1
-                      tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * shf(j,i)
-                   ENDIF
-
-                   IF ( use_top_fluxes )  THEN
-                      k = nzt
-                      tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * tswst(j,i)
-                   ENDIF
-
-                ENDIF
-
-             ENDIF
-
-          ELSE
-
-             DO  k = nzb_diff_s_inner(j,i), nzt_diff
-
-                IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets )  THEN
-                   k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                   k2 = 0.61_wp * pt(k,j,i)
-                   tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g / vpt(k,j,i) *   &
-                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) + &
-                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )   &
-                                         ) * dd2zu(k)
-                ELSE IF ( cloud_physics )  THEN
-                   IF ( ql(k,j,i) == 0.0_wp )  THEN
-                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                      k2 = 0.61_wp * pt(k,j,i)
-                   ELSE
-                      theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                      temp  = theta * t_d_pt(k)
-                      k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                 &
-                                    ( q(k,j,i) - ql(k,j,i) ) *          &
-                           ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
-                           ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
-                           ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                      k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                   ENDIF
-                   tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g / vpt(k,j,i) *   &
-                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) + &
-                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )   &
-                                         ) * dd2zu(k)
-                ELSE IF ( cloud_droplets )  THEN
-                   k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                   k2 = 0.61_wp * pt(k,j,i)
-                   tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g / vpt(k,j,i) *  &
-                                     ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +    &
-                                       k2 * ( q(k+1,j,i) - q(k-1,j,i) ) -    &
-                                       pt(k,j,i) * ( ql(k+1,j,i) -           &
-                                                     ql(k-1,j,i) ) ) * dd2zu(k)
-                ENDIF
-             ENDDO
-
-             IF ( use_surface_fluxes )  THEN
-                k = nzb_diff_s_inner(j,i)-1
-
-                IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets )  THEN
-                   k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                   k2 = 0.61_wp * pt(k,j,i)
-                ELSE IF ( cloud_physics )  THEN
-                   IF ( ql(k,j,i) == 0.0_wp )  THEN
-                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                      k2 = 0.61_wp * pt(k,j,i)
-                   ELSE
-                      theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                      temp  = theta * t_d_pt(k)
-                      k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                 &
-                                    ( q(k,j,i) - ql(k,j,i) ) *          &
-                           ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
-                           ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
-                           ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                      k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                   ENDIF
-                ELSE IF ( cloud_droplets )  THEN
-                   k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                   k2 = 0.61_wp * pt(k,j,i)
-                ENDIF
-
-                tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
-                                            ( k1* shf(j,i) + k2 * qsws(j,i) )
-             ENDIF
-
-             IF ( use_top_fluxes )  THEN
-                k = nzt
-
-                IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets )  THEN
-                   k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                   k2 = 0.61_wp * pt(k,j,i)
-                ELSE IF ( cloud_physics )  THEN
-                   IF ( ql(k,j,i) == 0.0_wp )  THEN
-                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                      k2 = 0.61_wp * pt(k,j,i)
-                   ELSE
-                      theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                      temp  = theta * t_d_pt(k)
-                      k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                 &
-                                    ( q(k,j,i) - ql(k,j,i) ) *          &
-                           ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
-                           ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
-                           ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                      k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                   ENDIF
-                ELSE IF ( cloud_droplets )  THEN
-                   k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                   k2 = 0.61_wp * pt(k,j,i)
-                ENDIF
-
-                tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
-                                            ( k1* tswst(j,i) + k2 * qswst(j,i) )
-             ENDIF
-
-          ENDIF
-
-       ENDIF
-
-    END SUBROUTINE production_e_ij
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!------------------------------------------------------------------------------!
-    SUBROUTINE production_e_init
-
-       USE arrays_3d,                                                          &
-           ONLY:  kh, km, u, us, usws, v, vsws, zu
-
-       USE control_parameters,                                                 &
-           ONLY:  constant_flux_layer, kappa
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb_u_inner,     &
-                  nzb_v_inner
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i   !<
-       INTEGER(iwp) ::  j   !<
-       INTEGER(iwp) ::  ku  !<
-       INTEGER(iwp) ::  kv  !<
-
-       IF ( constant_flux_layer )  THEN
-
-          IF ( first_call )  THEN
-             ALLOCATE( u_0(nysg:nyng,nxlg:nxrg), v_0(nysg:nyng,nxlg:nxrg) )
-             u_0 = 0.0_wp   ! just to avoid access of uninitialized memory
-             v_0 = 0.0_wp   ! within exchange_horiz_2d
-             first_call = .FALSE.
-          ENDIF
-
-!
-!--       Calculate a virtual velocity at the surface in a way that the
-!--       vertical velocity gradient at k = 1 (u(k+1)-u_0) matches the
-!--       Prandtl law (-w'u'/km). This gradient is used in the TKE shear
-!--       production term at k=1 (see production_e_ij).
-!--       The velocity gradient has to be limited in case of too small km
-!--       (otherwise the timestep may be significantly reduced by large
-!--       surface winds).
-!--       Upper bounds are nxr+1 and nyn+1 because otherwise these values are
-!--       not available in case of non-cyclic boundary conditions.
-!--       WARNING: the exact analytical solution would require the determination
-!--                of the eddy diffusivity by km = u* * kappa * zp / phi_m.
-          !$OMP PARALLEL DO PRIVATE( ku, kv )
-          DO  i = nxl, nxr+1
-             DO  j = nys, nyn+1
-
-                ku = nzb_u_inner(j,i)+1
-                kv = nzb_v_inner(j,i)+1
-
-                u_0(j,i) = u(ku+1,j,i) + usws(j,i) * ( zu(ku+1) - zu(ku-1) ) / &
-                                 ( 0.5_wp * ( km(ku,j,i) + km(ku,j,i-1) ) +    &
-                                   1.0E-20_wp )
-!                                  ( us(j,i) * kappa * zu(1) )
-                v_0(j,i) = v(kv+1,j,i) + vsws(j,i) * ( zu(kv+1) - zu(kv-1) ) / &
-                                 ( 0.5_wp * ( km(kv,j,i) + km(kv,j-1,i) ) +    &
-                                   1.0E-20_wp )
-!                                  ( us(j,i) * kappa * zu(1) )
-
-                IF ( ABS( u(ku+1,j,i) - u_0(j,i) )  > &
-                     ABS( u(ku+1,j,i) - u(ku-1,j,i) ) )  u_0(j,i) = u(ku-1,j,i)
-                IF ( ABS( v(kv+1,j,i) - v_0(j,i) )  > &
-                     ABS( v(kv+1,j,i) - v(kv-1,j,i) ) )  v_0(j,i) = v(kv-1,j,i)
-
-             ENDDO
-          ENDDO
-
-          CALL exchange_horiz_2d( u_0 )
-          CALL exchange_horiz_2d( v_0 )
-
-       ENDIF
-
-    END SUBROUTINE production_e_init
-
- END MODULE production_e_mod
Index: /palm/trunk/SOURCE/prognostic_equations.f90
===================================================================
--- /palm/trunk/SOURCE/prognostic_equations.f90	(revision 1873)
+++ /palm/trunk/SOURCE/prognostic_equations.f90	(revision 1873)
@@ -0,0 +1,2486 @@
+!> @file prognostic_equations.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1826 2016-04-07 12:01:39Z maronga
+! Renamed canopy model calls.
+! 
+! 1822 2016-04-07 07:49:42Z hoffmann
+! Kessler microphysics scheme moved to microphysics.
+!
+! 1757 2016-02-22 15:49:32Z maronga
+! 
+! 
+! 1691 2015-10-26 16:17:44Z maronga
+! Added optional model spin-up without radiation / land surface model calls.
+! Formatting corrections.
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1585 2015-04-30 07:05:52Z maronga
+! Added call for temperature tendency calculation due to radiative flux divergence
+! 
+! 1517 2015-01-07 19:12:25Z hoffmann
+! advec_s_bc_mod addded, since advec_s_bc is now a module
+!
+! 1496 2014-12-02 17:25:50Z maronga
+! Renamed "radiation" -> "cloud_top_radiation"
+! 
+! 1484 2014-10-21 10:53:05Z kanani
+! Changes due to new module structure of the plant canopy model:
+!   parameters cthf and plant_canopy moved to module plant_canopy_model_mod.
+! Removed double-listing of use_upstream_for_tke in ONLY-list of module
+! control_parameters
+! 
+! 1409 2014-05-23 12:11:32Z suehring
+! Bugfix: i_omp_start changed for advec_u_ws at left inflow and outflow boundary. 
+! This ensures that left-hand side fluxes are also calculated for nxl in that
+! case, even though the solution at nxl is overwritten in boundary_conds() 
+! 
+! 1398 2014-05-07 11:15:00Z heinze
+! Rayleigh-damping for horizontal velocity components changed: instead of damping
+! against ug and vg, damping against u_init and v_init is used to allow for a 
+! homogenized treatment in case of nudging
+! 
+! 1380 2014-04-28 12:40:45Z heinze
+! Change order of calls for scalar prognostic quantities: 
+! ls_advec -> nudging -> subsidence since initial profiles 
+! 
+! 1374 2014-04-25 12:55:07Z raasch
+! missing variables added to ONLY lists
+! 
+! 1365 2014-04-22 15:03:56Z boeske
+! Calls of ls_advec for large scale advection added, 
+! subroutine subsidence is only called if use_subsidence_tendencies = .F.,
+! new argument ls_index added to the calls of subsidence
+! +ls_index
+! 
+! 1361 2014-04-16 15:17:48Z hoffmann
+! Two-moment microphysics moved to the start of prognostic equations. This makes
+! the 3d arrays for tend_q, tend_qr, tend_pt and tend_pt redundant.
+! Additionally, it is allowed to call the microphysics just once during the time
+! step (not at each sub-time step).
+!
+! Two-moment cloud physics added for vector and accelerator optimization.
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+! 
+! 1337 2014-03-25 15:11:48Z heinze
+! Bugfix: REAL constants provided with KIND-attribute
+! 
+! 1332 2014-03-25 11:59:43Z suehring
+! Bugfix: call advec_ws or advec_pw for TKE only if NOT use_upstream_for_tke 
+! 
+! 1330 2014-03-24 17:29:32Z suehring
+! In case of SGS-particle velocity advection of TKE is also allowed with 
+! dissipative 5th-order scheme.
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! old module precision_kind is removed,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1318 2014-03-17 13:35:16Z raasch
+! module interfaces removed
+!
+! 1257 2013-11-08 15:18:40Z raasch
+! openacc loop vector clauses removed, independent clauses added
+!
+! 1246 2013-11-01 08:59:45Z heinze
+! enable nudging also for accelerator version
+!
+! 1241 2013-10-30 11:36:58Z heinze
+! usage of nudging enabled (so far not implemented for accelerator version)
+!
+! 1179 2013-06-14 05:57:58Z raasch
+! two arguments removed from routine buoyancy, ref_state updated on device
+!
+! 1128 2013-04-12 06:19:32Z raasch
+! those parts requiring global communication moved to time_integration,
+! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
+! j_north
+!
+! 1115 2013-03-26 18:16:16Z hoffmann
+! optimized cloud physics: calculation of microphysical tendencies transfered 
+! to microphysics.f90; qr and nr are only calculated if precipitation is required
+!
+! 1111 2013-03-08 23:54:10Z raasch
+! update directives for prognostic quantities removed
+!
+! 1106 2013-03-04 05:31:38Z raasch
+! small changes in code formatting
+!
+! 1092 2013-02-02 11:24:22Z raasch
+! unused variables removed
+!
+! 1053 2012-11-13 17:11:03Z hoffmann
+! implementation of two new prognostic equations for rain drop concentration (nr)
+! and rain water content (qr)
+!
+! currently, only available for cache loop optimization
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1019 2012-09-28 06:46:45Z raasch
+! non-optimized version of prognostic_equations removed
+!
+! 1015 2012-09-27 09:23:24Z raasch
+! new branch prognostic_equations_acc
+! OpenACC statements added + code changes required for GPU optimization
+!
+! 1001 2012-09-13 14:08:46Z raasch
+! all actions concerning leapfrog- and upstream-spline-scheme removed
+!
+! 978 2012-08-09 08:28:32Z fricke
+! km_damp_x and km_damp_y removed in calls of diffusion_u and diffusion_v
+! add ptdf_x, ptdf_y for damping the potential temperature at the inflow
+! boundary in case of non-cyclic lateral boundaries
+! Bugfix: first thread index changes for WS-scheme at the inflow
+!
+! 940 2012-07-09 14:31:00Z raasch
+! temperature equation can be switched off
+!
+! Revision 1.1  2000/04/13 14:56:27  schroeter
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Solving the prognostic equations.
+!------------------------------------------------------------------------------!
+ MODULE prognostic_equations_mod
+
+ 
+
+    USE arrays_3d,                                                             &
+        ONLY:  diss_l_e, diss_l_nr, diss_l_pt, diss_l_q, diss_l_qr,            &
+               diss_l_sa, diss_s_e, diss_s_nr, diss_s_pt, diss_s_q,            &
+               diss_s_qr, diss_s_sa, e, e_p, flux_s_e, flux_s_nr, flux_s_pt,   &
+               flux_s_q, flux_s_qr, flux_s_sa, flux_l_e, flux_l_nr,            &
+               flux_l_pt, flux_l_q, flux_l_qr, flux_l_sa, nr, nr_p, nrsws,     &
+               nrswst, pt, ptdf_x, ptdf_y, pt_init, pt_p, prho, q, q_init,     &
+               q_p, qsws, qswst, qr, qr_p, qrsws, qrswst, rdf, rdf_sc,         &
+               ref_state, rho, sa, sa_init, sa_p, saswsb, saswst, shf, tend,   &
+               te_m, tnr_m, tpt_m, tq_m, tqr_m, tsa_m, tswst, tu_m, tv_m,      &
+               tw_m, u, ug, u_init, u_p, v, vg, vpt, v_init, v_p, w, w_p
+        
+    USE control_parameters,                                                    &
+        ONLY:  call_microphysics_at_all_substeps, cloud_physics,               &
+               cloud_top_radiation, constant_diffusion, dp_external,           &
+               dp_level_ind_b, dp_smooth_factor, dpdxy, dt_3d, humidity,       &
+               inflow_l, intermediate_timestep_count,                          &
+               intermediate_timestep_count_max, large_scale_forcing,           &
+               large_scale_subsidence, microphysics_seifert,                   &
+               microphysics_sat_adjust, neutral, nudging, ocean, outflow_l,    &
+               outflow_s, passive_scalar, prho_reference, prho_reference,      &
+               prho_reference, pt_reference, pt_reference, pt_reference,       &
+               scalar_advec, scalar_advec, simulated_time, sloping_surface,    &
+               timestep_scheme, tsc, use_subsidence_tendencies,                &
+               use_upstream_for_tke, wall_heatflux,                            &
+               wall_nrflux, wall_qflux, wall_qflux, wall_qflux, wall_qrflux,   &
+               wall_salinityflux, ws_scheme_mom, ws_scheme_sca
+
+    USE cpulog,                                                                &
+        ONLY:  cpu_log, log_point
+
+    USE eqn_state_seawater_mod,                                                &
+        ONLY:  eqn_state_seawater
+
+    USE indices,                                                               &
+        ONLY:  i_left, i_right, j_north, j_south, nxl, nxlu, nxr, nyn, nys,    &
+               nysv, nzb_s_inner, nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
+
+    USE advec_ws,                                                              &
+        ONLY:  advec_s_ws, advec_s_ws_acc, advec_u_ws, advec_u_ws_acc,         &
+               advec_v_ws, advec_v_ws_acc, advec_w_ws, advec_w_ws_acc
+
+    USE advec_s_bc_mod,                                                        &
+        ONLY:  advec_s_bc
+
+    USE advec_s_pw_mod,                                                        &
+        ONLY:  advec_s_pw
+
+    USE advec_s_up_mod,                                                        &
+        ONLY:  advec_s_up
+
+    USE advec_u_pw_mod,                                                        &
+        ONLY:  advec_u_pw
+
+    USE advec_u_up_mod,                                                        &
+        ONLY:  advec_u_up
+
+    USE advec_v_pw_mod,                                                        &
+        ONLY:  advec_v_pw
+
+    USE advec_v_up_mod,                                                        &
+        ONLY:  advec_v_up
+
+    USE advec_w_pw_mod,                                                        &
+        ONLY:  advec_w_pw
+
+    USE advec_w_up_mod,                                                        &
+        ONLY:  advec_w_up
+
+    USE buoyancy_mod,                                                          &
+        ONLY:  buoyancy, buoyancy_acc
+
+    USE calc_radiation_mod,                                                    &
+        ONLY:  calc_radiation
+  
+    USE coriolis_mod,                                                          &
+        ONLY:  coriolis, coriolis_acc
+
+    USE diffusion_e_mod,                                                       &
+        ONLY:  diffusion_e, diffusion_e_acc
+
+    USE diffusion_s_mod,                                                       &
+        ONLY:  diffusion_s, diffusion_s_acc
+
+    USE diffusion_u_mod,                                                       &
+        ONLY:  diffusion_u, diffusion_u_acc
+
+    USE diffusion_v_mod,                                                       &
+        ONLY:  diffusion_v, diffusion_v_acc
+
+    USE diffusion_w_mod,                                                       &
+        ONLY:  diffusion_w, diffusion_w_acc
+
+    USE kinds
+
+    USE ls_forcing_mod,                                                        &
+        ONLY:  ls_advec
+
+    USE microphysics_mod,                                                      &
+        ONLY:  microphysics_control
+
+    USE nudge_mod,                                                             &
+        ONLY:  nudge
+
+    USE plant_canopy_model_mod,                                                &
+        ONLY:  cthf, plant_canopy, pcm_tendency
+
+    USE production_e_mod,                                                      &
+        ONLY:  production_e, production_e_acc
+
+    USE radiation_model_mod,                                                   &
+        ONLY:  radiation, radiation_scheme, radiation_tendency,                &
+               skip_time_do_radiation
+
+    USE statistics,                                                            &
+        ONLY:  hom
+
+    USE subsidence_mod,                                                        &
+        ONLY:  subsidence
+
+    USE user_actions_mod,                                                      &
+        ONLY:  user_actions
+
+
+    PRIVATE
+    PUBLIC prognostic_equations_cache, prognostic_equations_vector, &
+           prognostic_equations_acc
+
+    INTERFACE prognostic_equations_cache
+       MODULE PROCEDURE prognostic_equations_cache
+    END INTERFACE prognostic_equations_cache
+
+    INTERFACE prognostic_equations_vector
+       MODULE PROCEDURE prognostic_equations_vector
+    END INTERFACE prognostic_equations_vector
+
+    INTERFACE prognostic_equations_acc
+       MODULE PROCEDURE prognostic_equations_acc
+    END INTERFACE prognostic_equations_acc
+
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Version with one optimized loop over all equations. It is only allowed to
+!> be called for the Wicker and Skamarock or Piascek-Williams advection scheme.
+!>
+!> Here the calls of most subroutines are embedded in two DO loops over i and j,
+!> so communication between CPUs is not allowed (does not make sense) within
+!> these loops.
+!>
+!> (Optimized to avoid cache missings, i.e. for Power4/5-architectures.)
+!------------------------------------------------------------------------------!
+ 
+ SUBROUTINE prognostic_equations_cache
+
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i                   !<
+    INTEGER(iwp) ::  i_omp_start         !<
+    INTEGER(iwp) ::  j                   !<
+    INTEGER(iwp) ::  k                   !<
+    INTEGER(iwp) ::  omp_get_thread_num  !<
+    INTEGER(iwp) ::  tn = 0              !<
+    
+    LOGICAL      ::  loop_start          !<
+
+
+!
+!-- Time measurement can only be performed for the whole set of equations
+    CALL cpu_log( log_point(32), 'all progn.equations', 'start' )
+
+!
+!-- Loop over all prognostic equations
+!$OMP PARALLEL private (i,i_omp_start,j,k,loop_start,tn)
+
+!$  tn = omp_get_thread_num() 
+    loop_start = .TRUE.
+!$OMP DO
+    DO  i = nxl, nxr
+
+!
+!--    Store the first loop index. It differs for each thread and is required
+!--    later in advec_ws
+       IF ( loop_start )  THEN
+          loop_start  = .FALSE.
+          i_omp_start = i 
+       ENDIF
+
+       DO  j = nys, nyn
+!
+!--       If required, calculate cloud microphysics
+          IF ( cloud_physics  .AND.  .NOT. microphysics_sat_adjust  .AND.      &
+               ( intermediate_timestep_count == 1  .OR.                        &
+                 call_microphysics_at_all_substeps )                           &
+             )  THEN
+             CALL microphysics_control( i, j )
+          ENDIF
+!
+!--       Tendency terms for u-velocity component
+          IF ( .NOT. outflow_l  .OR.  i > nxl )  THEN
+
+             tend(:,j,i) = 0.0_wp
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( ws_scheme_mom )  THEN
+                   CALL advec_u_ws( i, j, i_omp_start, tn )
+                ELSE 
+                   CALL advec_u_pw( i, j )
+                ENDIF 
+             ELSE
+                CALL advec_u_up( i, j )
+             ENDIF
+             CALL diffusion_u( i, j )
+             CALL coriolis( i, j, 1 )
+             IF ( sloping_surface  .AND.  .NOT. neutral )  THEN
+                CALL buoyancy( i, j, pt, 1 )
+             ENDIF
+
+!
+!--          Drag by plant canopy
+             IF ( plant_canopy )  CALL pcm_tendency( i, j, 1 )
+
+!
+!--          External pressure gradient
+             IF ( dp_external )  THEN
+                DO  k = dp_level_ind_b+1, nzt
+                   tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
+                ENDDO
+             ENDIF
+
+!
+!--          Nudging
+             IF ( nudging )  CALL nudge( i, j, simulated_time, 'u' )
+
+             CALL user_actions( i, j, 'u-tendency' )
+!
+!--          Prognostic equation for u-velocity component
+             DO  k = nzb_u_inner(j,i)+1, nzt
+                u_p(k,j,i) = u(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
+                                                  tsc(3) * tu_m(k,j,i) )       &
+                                      - tsc(5) * rdf(k) * ( u(k,j,i) - u_init(k) )
+             ENDDO
+
+!
+!--          Calculate tendencies for the next Runge-Kutta step
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( intermediate_timestep_count == 1 )  THEN
+                   DO  k = nzb_u_inner(j,i)+1, nzt
+                      tu_m(k,j,i) = tend(k,j,i)
+                   ENDDO
+                ELSEIF ( intermediate_timestep_count < &
+                         intermediate_timestep_count_max )  THEN
+                   DO  k = nzb_u_inner(j,i)+1, nzt
+                      tu_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tu_m(k,j,i)
+                   ENDDO
+                ENDIF
+             ENDIF
+
+          ENDIF
+
+!
+!--       Tendency terms for v-velocity component
+          IF ( .NOT. outflow_s  .OR.  j > nys )  THEN
+
+             tend(:,j,i) = 0.0_wp
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( ws_scheme_mom )  THEN
+                    CALL advec_v_ws( i, j, i_omp_start, tn )
+                ELSE 
+                    CALL advec_v_pw( i, j )
+                ENDIF
+             ELSE
+                CALL advec_v_up( i, j )
+             ENDIF
+             CALL diffusion_v( i, j )
+             CALL coriolis( i, j, 2 )
+
+!
+!--          Drag by plant canopy
+             IF ( plant_canopy )  CALL pcm_tendency( i, j, 2 )        
+
+!
+!--          External pressure gradient
+             IF ( dp_external )  THEN
+                DO  k = dp_level_ind_b+1, nzt
+                   tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
+                ENDDO
+             ENDIF
+
+!
+!--          Nudging
+             IF ( nudging )  CALL nudge( i, j, simulated_time, 'v' )
+
+             CALL user_actions( i, j, 'v-tendency' )
+!
+!--          Prognostic equation for v-velocity component
+             DO  k = nzb_v_inner(j,i)+1, nzt
+                v_p(k,j,i) = v(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
+                                                  tsc(3) * tv_m(k,j,i) )       &
+                                      - tsc(5) * rdf(k) * ( v(k,j,i) - v_init(k) )
+             ENDDO
+
+!
+!--          Calculate tendencies for the next Runge-Kutta step
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( intermediate_timestep_count == 1 )  THEN
+                   DO  k = nzb_v_inner(j,i)+1, nzt
+                      tv_m(k,j,i) = tend(k,j,i)
+                   ENDDO
+                ELSEIF ( intermediate_timestep_count < &
+                         intermediate_timestep_count_max )  THEN
+                   DO  k = nzb_v_inner(j,i)+1, nzt
+                      tv_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tv_m(k,j,i)
+                   ENDDO
+                ENDIF
+             ENDIF
+
+          ENDIF
+
+!
+!--       Tendency terms for w-velocity component
+          tend(:,j,i) = 0.0_wp
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+             IF ( ws_scheme_mom )  THEN
+                CALL advec_w_ws( i, j, i_omp_start, tn )
+             ELSE 
+                CALL advec_w_pw( i, j )
+             END IF
+          ELSE
+             CALL advec_w_up( i, j )
+          ENDIF
+          CALL diffusion_w( i, j )
+          CALL coriolis( i, j, 3 )
+
+          IF ( .NOT. neutral )  THEN
+             IF ( ocean )  THEN
+                CALL buoyancy( i, j, rho, 3 )
+             ELSE
+                IF ( .NOT. humidity )  THEN
+                   CALL buoyancy( i, j, pt, 3 )
+                ELSE
+                   CALL buoyancy( i, j, vpt, 3 )
+                ENDIF
+             ENDIF
+          ENDIF
+
+!
+!--       Drag by plant canopy
+          IF ( plant_canopy )  CALL pcm_tendency( i, j, 3 )
+
+          CALL user_actions( i, j, 'w-tendency' )
+
+!
+!--       Prognostic equation for w-velocity component
+          DO  k = nzb_w_inner(j,i)+1, nzt-1
+             w_p(k,j,i) = w(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +          &
+                                               tsc(3) * tw_m(k,j,i) )          &
+                                   - tsc(5) * rdf(k) * w(k,j,i)
+          ENDDO
+
+!
+!--       Calculate tendencies for the next Runge-Kutta step
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+             IF ( intermediate_timestep_count == 1 )  THEN
+                DO  k = nzb_w_inner(j,i)+1, nzt-1
+                   tw_m(k,j,i) = tend(k,j,i)
+                ENDDO
+             ELSEIF ( intermediate_timestep_count < &
+                      intermediate_timestep_count_max )  THEN
+                DO  k = nzb_w_inner(j,i)+1, nzt-1
+                   tw_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tw_m(k,j,i)
+                ENDDO
+             ENDIF
+          ENDIF
+
+!
+!--       If required, compute prognostic equation for potential temperature
+          IF ( .NOT. neutral )  THEN
+!
+!--          Tendency terms for potential temperature
+             tend(:,j,i) = 0.0_wp
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                   IF ( ws_scheme_sca )  THEN
+                      CALL advec_s_ws( i, j, pt, 'pt', flux_s_pt, diss_s_pt, &
+                                       flux_l_pt, diss_l_pt, i_omp_start, tn )
+                   ELSE
+                      CALL advec_s_pw( i, j, pt )
+                   ENDIF
+             ELSE
+                CALL advec_s_up( i, j, pt )
+             ENDIF
+             CALL diffusion_s( i, j, pt, shf, tswst, wall_heatflux )
+
+!
+!--          If required compute heating/cooling due to long wave radiation
+!--          processes
+             IF ( cloud_top_radiation )  THEN
+                CALL calc_radiation( i, j )
+             ENDIF
+
+!
+!--          Consideration of heat sources within the plant canopy
+             IF ( plant_canopy  .AND.  cthf /= 0.0_wp )  THEN
+                CALL pcm_tendency( i, j, 4 )
+             ENDIF
+
+!
+!--          Large scale advection
+             IF ( large_scale_forcing )  THEN
+                CALL ls_advec( i, j, simulated_time, 'pt' )
+             ENDIF     
+
+!
+!--          Nudging
+             IF ( nudging )  CALL nudge( i, j, simulated_time, 'pt' ) 
+
+!
+!--          If required, compute effect of large-scale subsidence/ascent
+             IF ( large_scale_subsidence  .AND.                                &
+                  .NOT. use_subsidence_tendencies )  THEN
+                CALL subsidence( i, j, tend, pt, pt_init, 2 )
+             ENDIF
+
+!
+!--          If required, add tendency due to radiative heating/cooling
+             IF ( radiation .AND. radiation_scheme == 'rrtmg' .AND.            &
+                  simulated_time > skip_time_do_radiation )  THEN
+                CALL radiation_tendency ( i, j, tend )
+             ENDIF
+
+
+             CALL user_actions( i, j, 'pt-tendency' )
+
+!
+!--          Prognostic equation for potential temperature
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                pt_p(k,j,i) = pt(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +     &
+                                                    tsc(3) * tpt_m(k,j,i) )    &
+                                        - tsc(5) * ( pt(k,j,i) - pt_init(k) ) *&
+                                          ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) )
+             ENDDO
+
+!
+!--          Calculate tendencies for the next Runge-Kutta step
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( intermediate_timestep_count == 1 )  THEN
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tpt_m(k,j,i) = tend(k,j,i)
+                   ENDDO
+                ELSEIF ( intermediate_timestep_count < &
+                         intermediate_timestep_count_max )  THEN
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tpt_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
+                                      5.3125_wp * tpt_m(k,j,i)
+                   ENDDO
+                ENDIF
+             ENDIF
+
+          ENDIF
+
+!
+!--       If required, compute prognostic equation for salinity
+          IF ( ocean )  THEN
+
+!
+!--          Tendency-terms for salinity
+             tend(:,j,i) = 0.0_wp
+             IF ( timestep_scheme(1:5) == 'runge' ) &
+             THEN
+                IF ( ws_scheme_sca )  THEN
+                    CALL advec_s_ws( i, j, sa, 'sa', flux_s_sa,  &
+                                diss_s_sa, flux_l_sa, diss_l_sa, i_omp_start, tn  )
+                ELSE 
+                    CALL advec_s_pw( i, j, sa )
+                ENDIF
+             ELSE
+                CALL advec_s_up( i, j, sa )
+             ENDIF
+             CALL diffusion_s( i, j, sa, saswsb, saswst, wall_salinityflux )
+
+             CALL user_actions( i, j, 'sa-tendency' )
+
+!
+!--          Prognostic equation for salinity
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                sa_p(k,j,i) = sa(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +     &
+                                                    tsc(3) * tsa_m(k,j,i) )    &
+                                        - tsc(5) * rdf_sc(k) *                 &
+                                          ( sa(k,j,i) - sa_init(k) )
+                IF ( sa_p(k,j,i) < 0.0_wp )  sa_p(k,j,i) = 0.1_wp * sa(k,j,i)
+             ENDDO
+
+!
+!--          Calculate tendencies for the next Runge-Kutta step
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( intermediate_timestep_count == 1 )  THEN
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tsa_m(k,j,i) = tend(k,j,i)
+                   ENDDO
+                ELSEIF ( intermediate_timestep_count < &
+                         intermediate_timestep_count_max )  THEN
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tsa_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
+                                      5.3125_wp * tsa_m(k,j,i)
+                   ENDDO
+                ENDIF
+             ENDIF
+
+!
+!--          Calculate density by the equation of state for seawater
+             CALL eqn_state_seawater( i, j )
+
+          ENDIF
+
+!
+!--       If required, compute prognostic equation for total water content /
+!--       scalar
+          IF ( humidity  .OR.  passive_scalar )  THEN
+
+!
+!--          Tendency-terms for total water content / scalar
+             tend(:,j,i) = 0.0_wp
+             IF ( timestep_scheme(1:5) == 'runge' ) &
+             THEN
+                IF ( ws_scheme_sca )  THEN
+                   CALL advec_s_ws( i, j, q, 'q', flux_s_q, & 
+                                diss_s_q, flux_l_q, diss_l_q, i_omp_start, tn )
+                ELSE 
+                   CALL advec_s_pw( i, j, q )
+                ENDIF
+             ELSE
+                CALL advec_s_up( i, j, q )
+             ENDIF
+             CALL diffusion_s( i, j, q, qsws, qswst, wall_qflux )
+
+!
+!--          Sink or source of scalar concentration due to canopy elements
+             IF ( plant_canopy )  CALL pcm_tendency( i, j, 5 )
+
+!
+!--          Large scale advection
+             IF ( large_scale_forcing )  THEN
+                CALL ls_advec( i, j, simulated_time, 'q' )
+             ENDIF
+
+!
+!--          Nudging
+             IF ( nudging )  CALL nudge( i, j, simulated_time, 'q' ) 
+
+!
+!--          If required compute influence of large-scale subsidence/ascent
+             IF ( large_scale_subsidence  .AND.                                &
+                  .NOT. use_subsidence_tendencies )  THEN
+                CALL subsidence( i, j, tend, q, q_init, 3 )
+             ENDIF
+
+             CALL user_actions( i, j, 'q-tendency' )
+
+!
+!--          Prognostic equation for total water content / scalar
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                q_p(k,j,i) = q(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
+                                                  tsc(3) * tq_m(k,j,i) )       &
+                                      - tsc(5) * rdf_sc(k) *                   &
+                                        ( q(k,j,i) - q_init(k) )
+                IF ( q_p(k,j,i) < 0.0_wp )  q_p(k,j,i) = 0.1_wp * q(k,j,i)
+             ENDDO
+
+!
+!--          Calculate tendencies for the next Runge-Kutta step
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( intermediate_timestep_count == 1 )  THEN
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tq_m(k,j,i) = tend(k,j,i)
+                   ENDDO
+                ELSEIF ( intermediate_timestep_count < &
+                         intermediate_timestep_count_max )  THEN
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tq_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
+                                     5.3125_wp * tq_m(k,j,i)
+                   ENDDO
+                ENDIF
+             ENDIF
+
+!
+!--          If required, calculate prognostic equations for rain water content 
+!--          and rain drop concentration
+             IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
+!
+!--             Calculate prognostic equation for rain water content
+                tend(:,j,i) = 0.0_wp
+                IF ( timestep_scheme(1:5) == 'runge' ) &
+                THEN
+                   IF ( ws_scheme_sca )  THEN
+                      CALL advec_s_ws( i, j, qr, 'qr', flux_s_qr,       & 
+                                       diss_s_qr, flux_l_qr, diss_l_qr, &
+                                       i_omp_start, tn )
+                   ELSE 
+                      CALL advec_s_pw( i, j, qr )
+                   ENDIF
+                ELSE
+                   CALL advec_s_up( i, j, qr )
+                ENDIF
+                CALL diffusion_s( i, j, qr, qrsws, qrswst, wall_qrflux )
+
+!
+!--             Prognostic equation for rain water content
+                DO  k = nzb_s_inner(j,i)+1, nzt
+                   qr_p(k,j,i) = qr(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +  &
+                                                       tsc(3) * tqr_m(k,j,i) ) &
+                                           - tsc(5) * rdf_sc(k) * qr(k,j,i)
+                   IF ( qr_p(k,j,i) < 0.0_wp )  qr_p(k,j,i) = 0.0_wp
+                ENDDO
+!
+!--             Calculate tendencies for the next Runge-Kutta step
+                IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                   IF ( intermediate_timestep_count == 1 )  THEN
+                      DO  k = nzb_s_inner(j,i)+1, nzt
+                         tqr_m(k,j,i) = tend(k,j,i)
+                      ENDDO
+                   ELSEIF ( intermediate_timestep_count < &
+                            intermediate_timestep_count_max )  THEN
+                      DO  k = nzb_s_inner(j,i)+1, nzt
+                         tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
+                                        5.3125_wp * tqr_m(k,j,i)
+                      ENDDO
+                   ENDIF
+                ENDIF
+
+!
+!--             Calculate prognostic equation for rain drop concentration.
+                tend(:,j,i) = 0.0_wp
+                IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                   IF ( ws_scheme_sca )  THEN
+                      CALL advec_s_ws( i, j, nr, 'nr', flux_s_nr,    & 
+                                    diss_s_nr, flux_l_nr, diss_l_nr, &
+                                    i_omp_start, tn )
+                   ELSE 
+                      CALL advec_s_pw( i, j, nr )
+                   ENDIF
+                ELSE
+                   CALL advec_s_up( i, j, nr )
+                ENDIF
+                CALL diffusion_s( i, j, nr, nrsws, nrswst, wall_nrflux )
+
+!
+!--             Prognostic equation for rain drop concentration
+                DO  k = nzb_s_inner(j,i)+1, nzt
+                   nr_p(k,j,i) = nr(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +  &
+                                                       tsc(3) * tnr_m(k,j,i) ) &
+                                           - tsc(5) * rdf_sc(k) * nr(k,j,i)
+                   IF ( nr_p(k,j,i) < 0.0_wp )  nr_p(k,j,i) = 0.0_wp
+                ENDDO
+!
+!--             Calculate tendencies for the next Runge-Kutta step
+                IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                   IF ( intermediate_timestep_count == 1 )  THEN
+                      DO  k = nzb_s_inner(j,i)+1, nzt
+                         tnr_m(k,j,i) = tend(k,j,i)
+                      ENDDO
+                   ELSEIF ( intermediate_timestep_count < &
+                            intermediate_timestep_count_max )  THEN
+                      DO  k = nzb_s_inner(j,i)+1, nzt
+                         tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
+                                        5.3125_wp * tnr_m(k,j,i)
+                      ENDDO
+                   ENDIF
+                ENDIF
+
+             ENDIF
+
+          ENDIF
+
+!
+!--       If required, compute prognostic equation for turbulent kinetic 
+!--       energy (TKE)
+          IF ( .NOT. constant_diffusion )  THEN
+
+!
+!--          Tendency-terms for TKE
+             tend(:,j,i) = 0.0_wp
+             IF ( timestep_scheme(1:5) == 'runge'  &
+                 .AND.  .NOT. use_upstream_for_tke )  THEN 
+                 IF ( ws_scheme_sca )  THEN
+                     CALL advec_s_ws( i, j, e, 'e', flux_s_e, diss_s_e, &
+                                      flux_l_e, diss_l_e , i_omp_start, tn )
+                 ELSE
+                     CALL advec_s_pw( i, j, e )
+                 ENDIF
+             ELSE
+                CALL advec_s_up( i, j, e )
+             ENDIF
+             IF ( .NOT. humidity )  THEN
+                IF ( ocean )  THEN
+                   CALL diffusion_e( i, j, prho, prho_reference )
+                ELSE
+                   CALL diffusion_e( i, j, pt, pt_reference )
+                ENDIF
+             ELSE
+                CALL diffusion_e( i, j, vpt, pt_reference )
+             ENDIF
+             CALL production_e( i, j )
+
+!
+!--          Additional sink term for flows through plant canopies
+             IF ( plant_canopy )  CALL pcm_tendency( i, j, 6 ) 
+
+             CALL user_actions( i, j, 'e-tendency' )
+
+!
+!--          Prognostic equation for TKE.
+!--          Eliminate negative TKE values, which can occur due to numerical
+!--          reasons in the course of the integration. In such cases the old
+!--          TKE value is reduced by 90%.
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                e_p(k,j,i) = e(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
+                                                  tsc(3) * te_m(k,j,i) )
+                IF ( e_p(k,j,i) < 0.0_wp )  e_p(k,j,i) = 0.1_wp * e(k,j,i)
+             ENDDO
+
+!
+!--          Calculate tendencies for the next Runge-Kutta step
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( intermediate_timestep_count == 1 )  THEN
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      te_m(k,j,i) = tend(k,j,i)
+                   ENDDO
+                ELSEIF ( intermediate_timestep_count < &
+                         intermediate_timestep_count_max )  THEN
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      te_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
+                                     5.3125_wp * te_m(k,j,i)
+                   ENDDO
+                ENDIF
+             ENDIF
+
+          ENDIF   ! TKE equation
+
+       ENDDO
+    ENDDO
+!$OMP END PARALLEL
+
+    CALL cpu_log( log_point(32), 'all progn.equations', 'stop' )
+
+
+ END SUBROUTINE prognostic_equations_cache
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Version for vector machines
+!------------------------------------------------------------------------------!
+ 
+ SUBROUTINE prognostic_equations_vector
+
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i    !<
+    INTEGER(iwp) ::  j    !<
+    INTEGER(iwp) ::  k    !<
+
+    REAL(wp)     ::  sbt  !<
+
+
+!
+!-- If required, calculate cloud microphysical impacts
+    IF ( cloud_physics  .AND.  .NOT. microphysics_sat_adjust  .AND.            &
+         ( intermediate_timestep_count == 1  .OR.                              &
+           call_microphysics_at_all_substeps )                                 &
+       )  THEN
+       CALL cpu_log( log_point(51), 'microphysics', 'start' )
+       CALL microphysics_control
+       CALL cpu_log( log_point(51), 'microphysics', 'stop' )
+    ENDIF
+
+!
+!-- u-velocity component
+    CALL cpu_log( log_point(5), 'u-equation', 'start' )
+
+    tend = 0.0_wp
+    IF ( timestep_scheme(1:5) == 'runge' )  THEN
+       IF ( ws_scheme_mom )  THEN
+          CALL advec_u_ws
+       ELSE
+          CALL advec_u_pw
+       ENDIF
+    ELSE
+       CALL advec_u_up
+    ENDIF
+    CALL diffusion_u
+    CALL coriolis( 1 )
+    IF ( sloping_surface  .AND.  .NOT. neutral )  THEN
+       CALL buoyancy( pt, 1 )
+    ENDIF
+
+!
+!-- Drag by plant canopy
+    IF ( plant_canopy )  CALL pcm_tendency( 1 )
+
+!
+!-- External pressure gradient
+    IF ( dp_external )  THEN
+       DO  i = nxlu, nxr
+          DO  j = nys, nyn
+             DO  k = dp_level_ind_b+1, nzt
+                tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- Nudging
+    IF ( nudging )  CALL nudge( simulated_time, 'u' )
+
+    CALL user_actions( 'u-tendency' )
+
+!
+!-- Prognostic equation for u-velocity component
+    DO  i = nxlu, nxr
+       DO  j = nys, nyn
+          DO  k = nzb_u_inner(j,i)+1, nzt
+             u_p(k,j,i) = u(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +          &
+                                               tsc(3) * tu_m(k,j,i) )          &
+                                   - tsc(5) * rdf(k) * ( u(k,j,i) - u_init(k) )
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+    IF ( timestep_scheme(1:5) == 'runge' )  THEN
+       IF ( intermediate_timestep_count == 1 )  THEN
+          DO  i = nxlu, nxr
+             DO  j = nys, nyn
+                DO  k = nzb_u_inner(j,i)+1, nzt
+                   tu_m(k,j,i) = tend(k,j,i)
+                ENDDO
+             ENDDO
+          ENDDO
+       ELSEIF ( intermediate_timestep_count < &
+                intermediate_timestep_count_max )  THEN
+          DO  i = nxlu, nxr
+             DO  j = nys, nyn
+                DO  k = nzb_u_inner(j,i)+1, nzt
+                   tu_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tu_m(k,j,i)
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDIF
+    ENDIF
+
+    CALL cpu_log( log_point(5), 'u-equation', 'stop' )
+
+!
+!-- v-velocity component
+    CALL cpu_log( log_point(6), 'v-equation', 'start' )
+
+    tend = 0.0_wp
+    IF ( timestep_scheme(1:5) == 'runge' )  THEN
+       IF ( ws_scheme_mom )  THEN
+          CALL advec_v_ws
+       ELSE 
+          CALL advec_v_pw
+       END IF
+    ELSE
+       CALL advec_v_up
+    ENDIF
+    CALL diffusion_v
+    CALL coriolis( 2 )
+
+!
+!-- Drag by plant canopy
+    IF ( plant_canopy )  CALL pcm_tendency( 2 )
+
+!
+!-- External pressure gradient
+    IF ( dp_external )  THEN
+       DO  i = nxl, nxr
+          DO  j = nysv, nyn
+             DO  k = dp_level_ind_b+1, nzt
+                tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- Nudging
+    IF ( nudging )  CALL nudge( simulated_time, 'v' )
+
+    CALL user_actions( 'v-tendency' )
+
+!
+!-- Prognostic equation for v-velocity component
+    DO  i = nxl, nxr
+       DO  j = nysv, nyn
+          DO  k = nzb_v_inner(j,i)+1, nzt
+             v_p(k,j,i) = v(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +          &
+                                               tsc(3) * tv_m(k,j,i) )          &
+                                   - tsc(5) * rdf(k) * ( v(k,j,i) - v_init(k) )
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+    IF ( timestep_scheme(1:5) == 'runge' )  THEN
+       IF ( intermediate_timestep_count == 1 )  THEN
+          DO  i = nxl, nxr
+             DO  j = nysv, nyn
+                DO  k = nzb_v_inner(j,i)+1, nzt
+                   tv_m(k,j,i) = tend(k,j,i)
+                ENDDO
+             ENDDO
+          ENDDO
+       ELSEIF ( intermediate_timestep_count < &
+                intermediate_timestep_count_max )  THEN
+          DO  i = nxl, nxr
+             DO  j = nysv, nyn
+                DO  k = nzb_v_inner(j,i)+1, nzt
+                   tv_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tv_m(k,j,i)
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDIF
+    ENDIF
+
+    CALL cpu_log( log_point(6), 'v-equation', 'stop' )
+
+!
+!-- w-velocity component
+    CALL cpu_log( log_point(7), 'w-equation', 'start' )
+
+    tend = 0.0_wp
+    IF ( timestep_scheme(1:5) == 'runge' )  THEN
+       IF ( ws_scheme_mom )  THEN
+          CALL advec_w_ws
+       ELSE
+          CALL advec_w_pw
+       ENDIF
+    ELSE
+       CALL advec_w_up
+    ENDIF
+    CALL diffusion_w
+    CALL coriolis( 3 )
+
+    IF ( .NOT. neutral )  THEN
+       IF ( ocean )  THEN
+          CALL buoyancy( rho, 3 )
+       ELSE
+          IF ( .NOT. humidity )  THEN
+             CALL buoyancy( pt, 3 )
+          ELSE
+             CALL buoyancy( vpt, 3 )
+          ENDIF
+       ENDIF
+    ENDIF
+
+!
+!-- Drag by plant canopy
+    IF ( plant_canopy )  CALL pcm_tendency( 3 )
+
+    CALL user_actions( 'w-tendency' )
+
+!
+!-- Prognostic equation for w-velocity component
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb_w_inner(j,i)+1, nzt-1
+             w_p(k,j,i) = w(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +          &
+                                               tsc(3) * tw_m(k,j,i) )          &
+                                   - tsc(5) * rdf(k) * w(k,j,i)
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+    IF ( timestep_scheme(1:5) == 'runge' )  THEN
+       IF ( intermediate_timestep_count == 1 )  THEN
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                DO  k = nzb_w_inner(j,i)+1, nzt-1
+                   tw_m(k,j,i) = tend(k,j,i)
+                ENDDO
+             ENDDO
+          ENDDO
+       ELSEIF ( intermediate_timestep_count < &
+                intermediate_timestep_count_max )  THEN
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                DO  k = nzb_w_inner(j,i)+1, nzt-1
+                   tw_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tw_m(k,j,i)
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDIF
+    ENDIF
+
+    CALL cpu_log( log_point(7), 'w-equation', 'stop' )
+
+
+!
+!-- If required, compute prognostic equation for potential temperature
+    IF ( .NOT. neutral )  THEN
+
+       CALL cpu_log( log_point(13), 'pt-equation', 'start' )
+
+!
+!--    pt-tendency terms with communication
+       sbt = tsc(2)
+       IF ( scalar_advec == 'bc-scheme' )  THEN
+
+          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--          Bott-Chlond scheme always uses Euler time step. Thus:
+             sbt = 1.0_wp
+          ENDIF
+          tend = 0.0_wp
+          CALL advec_s_bc( pt, 'pt' )
+
+       ENDIF
+
+!
+!--    pt-tendency terms with no communication
+       IF ( scalar_advec /= 'bc-scheme' )  THEN
+          tend = 0.0_wp
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+             IF ( ws_scheme_sca )  THEN
+                CALL advec_s_ws( pt, 'pt' )
+             ELSE
+                CALL advec_s_pw( pt )
+             ENDIF
+          ELSE
+             CALL advec_s_up( pt )
+          ENDIF
+       ENDIF
+
+       CALL diffusion_s( pt, shf, tswst, wall_heatflux )
+
+!
+!--    If required compute heating/cooling due to long wave radiation processes
+       IF ( cloud_top_radiation )  THEN
+          CALL calc_radiation
+       ENDIF
+
+!
+!--    Consideration of heat sources within the plant canopy
+       IF ( plant_canopy .AND. ( cthf /= 0.0_wp ) ) THEN
+          CALL pcm_tendency( 4 )
+       ENDIF
+
+!
+!--    Large scale advection
+       IF ( large_scale_forcing )  THEN
+          CALL ls_advec( simulated_time, 'pt' )
+       ENDIF
+
+!
+!--    Nudging
+       IF ( nudging )  CALL nudge( simulated_time, 'pt' ) 
+
+!
+!--    If required compute influence of large-scale subsidence/ascent
+       IF ( large_scale_subsidence  .AND.                                      &
+            .NOT. use_subsidence_tendencies )  THEN
+          CALL subsidence( tend, pt, pt_init, 2 )
+       ENDIF
+
+!
+!--    If required, add tendency due to radiative heating/cooling
+       IF ( radiation .AND. radiation_scheme == 'rrtmg' .AND.                  &
+            simulated_time > skip_time_do_radiation )  THEN
+            CALL radiation_tendency ( tend )
+       ENDIF
+
+       CALL user_actions( 'pt-tendency' )
+
+!
+!--    Prognostic equation for potential temperature
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                pt_p(k,j,i) = pt(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +        &
+                                                    tsc(3) * tpt_m(k,j,i) )    &
+                                        - tsc(5) * ( pt(k,j,i) - pt_init(k) ) *&
+                                          ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) )
+             ENDDO
+          ENDDO
+       ENDDO
+
+!
+!--    Calculate tendencies for the next Runge-Kutta step
+       IF ( timestep_scheme(1:5) == 'runge' )  THEN
+          IF ( intermediate_timestep_count == 1 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tpt_m(k,j,i) = tend(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ELSEIF ( intermediate_timestep_count < &
+                   intermediate_timestep_count_max )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tpt_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
+                                      5.3125_wp * tpt_m(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+       ENDIF
+
+       CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
+
+    ENDIF
+
+!
+!-- If required, compute prognostic equation for salinity
+    IF ( ocean )  THEN
+
+       CALL cpu_log( log_point(37), 'sa-equation', 'start' )
+
+!
+!--    sa-tendency terms with communication
+       sbt = tsc(2)
+       IF ( scalar_advec == 'bc-scheme' )  THEN
+
+          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--          Bott-Chlond scheme always uses Euler time step. Thus:
+             sbt = 1.0_wp
+          ENDIF
+          tend = 0.0_wp
+          CALL advec_s_bc( sa, 'sa' )
+
+       ENDIF
+
+!
+!--    sa-tendency terms with no communication
+       IF ( scalar_advec /= 'bc-scheme' )  THEN
+          tend = 0.0_wp
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+             IF ( ws_scheme_sca )  THEN
+                 CALL advec_s_ws( sa, 'sa' )
+             ELSE
+                 CALL advec_s_pw( sa )
+             ENDIF
+          ELSE
+             CALL advec_s_up( sa )
+          ENDIF
+       ENDIF
+
+       CALL diffusion_s( sa, saswsb, saswst, wall_salinityflux )
+       
+       CALL user_actions( 'sa-tendency' )
+
+!
+!--    Prognostic equation for salinity
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                sa_p(k,j,i) = sa(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +        &
+                                                    tsc(3) * tsa_m(k,j,i) )    &
+                                        - tsc(5) * rdf_sc(k) *                 &
+                                          ( sa(k,j,i) - sa_init(k) )
+                IF ( sa_p(k,j,i) < 0.0_wp )  sa_p(k,j,i) = 0.1_wp * sa(k,j,i)
+             ENDDO
+          ENDDO
+       ENDDO
+
+!
+!--    Calculate tendencies for the next Runge-Kutta step
+       IF ( timestep_scheme(1:5) == 'runge' )  THEN
+          IF ( intermediate_timestep_count == 1 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tsa_m(k,j,i) = tend(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ELSEIF ( intermediate_timestep_count < &
+                   intermediate_timestep_count_max )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tsa_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
+                                      5.3125_wp * tsa_m(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+       ENDIF
+
+       CALL cpu_log( log_point(37), 'sa-equation', 'stop' )
+
+!
+!--    Calculate density by the equation of state for seawater
+       CALL cpu_log( log_point(38), 'eqns-seawater', 'start' )
+       CALL eqn_state_seawater
+       CALL cpu_log( log_point(38), 'eqns-seawater', 'stop' )
+
+    ENDIF
+
+!
+!-- If required, compute prognostic equation for total water content / scalar
+    IF ( humidity  .OR.  passive_scalar )  THEN
+
+       CALL cpu_log( log_point(29), 'q/s-equation', 'start' )
+
+!
+!--    Scalar/q-tendency terms with communication
+       sbt = tsc(2)
+       IF ( scalar_advec == 'bc-scheme' )  THEN
+
+          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--          Bott-Chlond scheme always uses Euler time step. Thus:
+             sbt = 1.0_wp
+          ENDIF
+          tend = 0.0_wp
+          CALL advec_s_bc( q, 'q' )
+
+       ENDIF
+
+!
+!--    Scalar/q-tendency terms with no communication
+       IF ( scalar_advec /= 'bc-scheme' )  THEN
+          tend = 0.0_wp
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+             IF ( ws_scheme_sca )  THEN
+                CALL advec_s_ws( q, 'q' )
+             ELSE
+                CALL advec_s_pw( q )
+             ENDIF
+          ELSE
+             CALL advec_s_up( q )
+          ENDIF
+       ENDIF
+
+       CALL diffusion_s( q, qsws, qswst, wall_qflux )
+       
+!
+!--    Sink or source of scalar concentration due to canopy elements
+       IF ( plant_canopy ) CALL pcm_tendency( 5 )
+
+!
+!--    Large scale advection
+       IF ( large_scale_forcing )  THEN
+          CALL ls_advec( simulated_time, 'q' )
+       ENDIF
+
+!
+!--    Nudging
+       IF ( nudging )  CALL nudge( simulated_time, 'q' ) 
+
+!
+!--    If required compute influence of large-scale subsidence/ascent
+       IF ( large_scale_subsidence  .AND.                                      &
+            .NOT. use_subsidence_tendencies )  THEN
+         CALL subsidence( tend, q, q_init, 3 )
+       ENDIF
+
+       CALL user_actions( 'q-tendency' )
+
+!
+!--    Prognostic equation for total water content / scalar
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                q_p(k,j,i) = q(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +          &
+                                                  tsc(3) * tq_m(k,j,i) )       &
+                                      - tsc(5) * rdf_sc(k) *                   &
+                                        ( q(k,j,i) - q_init(k) )
+                IF ( q_p(k,j,i) < 0.0_wp )  q_p(k,j,i) = 0.1_wp * q(k,j,i)
+             ENDDO
+          ENDDO
+       ENDDO
+
+!
+!--    Calculate tendencies for the next Runge-Kutta step
+       IF ( timestep_scheme(1:5) == 'runge' )  THEN
+          IF ( intermediate_timestep_count == 1 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tq_m(k,j,i) = tend(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ELSEIF ( intermediate_timestep_count < &
+                   intermediate_timestep_count_max )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      tq_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tq_m(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+       ENDIF
+
+       CALL cpu_log( log_point(29), 'q/s-equation', 'stop' )
+
+!
+!--    If required, calculate prognostic equations for rain water content 
+!--    and rain drop concentration
+       IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
+
+          CALL cpu_log( log_point(52), 'qr-equation', 'start' )
+
+!
+!--       Calculate prognostic equation for rain water content
+          sbt = tsc(2)
+          IF ( scalar_advec == 'bc-scheme' )  THEN
+
+             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--             Bott-Chlond scheme always uses Euler time step. Thus:
+                sbt = 1.0_wp
+             ENDIF
+             tend = 0.0_wp
+             CALL advec_s_bc( qr, 'qr' )
+
+          ENDIF
+
+!
+!--       qr-tendency terms with no communication
+          IF ( scalar_advec /= 'bc-scheme' )  THEN
+             tend = 0.0_wp
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( ws_scheme_sca )  THEN
+                   CALL advec_s_ws( qr, 'qr' )
+                ELSE
+                   CALL advec_s_pw( qr )
+                ENDIF
+             ELSE
+                CALL advec_s_up( qr )
+             ENDIF
+          ENDIF
+
+          CALL diffusion_s( qr, qrsws, qrswst, wall_qrflux )
+
+          CALL user_actions( 'qr-tendency' )
+
+!
+!--       Prognostic equation for rain water content
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                DO  k = nzb_s_inner(j,i)+1, nzt
+                   qr_p(k,j,i) = qr(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +     &
+                                                     tsc(3) * tqr_m(k,j,i) )   &
+                                           - tsc(5) * rdf_sc(k) * qr(k,j,i)
+                   IF ( qr_p(k,j,i) < 0.0_wp )  qr_p(k,j,i) = 0.0_wp
+                ENDDO
+             ENDDO
+          ENDDO
+
+!
+!--       Calculate tendencies for the next Runge-Kutta step
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+             IF ( intermediate_timestep_count == 1 )  THEN
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      DO  k = nzb_s_inner(j,i)+1, nzt
+                         tqr_m(k,j,i) = tend(k,j,i)
+                      ENDDO
+                   ENDDO
+                ENDDO
+             ELSEIF ( intermediate_timestep_count < &
+                      intermediate_timestep_count_max )  THEN
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      DO  k = nzb_s_inner(j,i)+1, nzt
+                         tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * &
+                                                                   tqr_m(k,j,i)
+                      ENDDO
+                   ENDDO
+                ENDDO
+             ENDIF
+          ENDIF
+
+          CALL cpu_log( log_point(52), 'qr-equation', 'stop' )
+          CALL cpu_log( log_point(53), 'nr-equation', 'start' )
+
+!
+!--       Calculate prognostic equation for rain drop concentration
+          sbt = tsc(2)
+          IF ( scalar_advec == 'bc-scheme' )  THEN
+
+             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--             Bott-Chlond scheme always uses Euler time step. Thus:
+                sbt = 1.0_wp
+             ENDIF
+             tend = 0.0_wp
+             CALL advec_s_bc( nr, 'nr' )
+
+          ENDIF
+
+!
+!--       nr-tendency terms with no communication
+          IF ( scalar_advec /= 'bc-scheme' )  THEN
+             tend = 0.0_wp
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( ws_scheme_sca )  THEN
+                   CALL advec_s_ws( nr, 'nr' )
+                ELSE
+                   CALL advec_s_pw( nr )
+                ENDIF
+             ELSE
+                CALL advec_s_up( nr )
+             ENDIF
+          ENDIF
+
+          CALL diffusion_s( nr, nrsws, nrswst, wall_nrflux )
+
+!
+!--       Prognostic equation for rain drop concentration
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                DO  k = nzb_s_inner(j,i)+1, nzt
+                   nr_p(k,j,i) = nr(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +     &
+                                                     tsc(3) * tnr_m(k,j,i) )   &
+                                           - tsc(5) * rdf_sc(k) * nr(k,j,i)
+                   IF ( nr_p(k,j,i) < 0.0_wp )  nr_p(k,j,i) = 0.0_wp
+                ENDDO
+             ENDDO
+          ENDDO
+
+!
+!--       Calculate tendencies for the next Runge-Kutta step
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+             IF ( intermediate_timestep_count == 1 )  THEN
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      DO  k = nzb_s_inner(j,i)+1, nzt
+                         tnr_m(k,j,i) = tend(k,j,i)
+                      ENDDO
+                   ENDDO
+                ENDDO
+             ELSEIF ( intermediate_timestep_count < &
+                      intermediate_timestep_count_max )  THEN
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      DO  k = nzb_s_inner(j,i)+1, nzt
+                         tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * &
+                                                                   tnr_m(k,j,i)
+                      ENDDO
+                   ENDDO
+                ENDDO
+             ENDIF
+          ENDIF
+
+          CALL cpu_log( log_point(53), 'nr-equation', 'stop' )
+
+       ENDIF
+
+    ENDIF
+
+!
+!-- If required, compute prognostic equation for turbulent kinetic 
+!-- energy (TKE)
+    IF ( .NOT. constant_diffusion )  THEN
+
+       CALL cpu_log( log_point(16), 'tke-equation', 'start' )
+
+       sbt = tsc(2)
+       IF ( .NOT. use_upstream_for_tke )  THEN
+          IF ( scalar_advec == 'bc-scheme' )  THEN
+
+             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--             Bott-Chlond scheme always uses Euler time step. Thus:
+                sbt = 1.0_wp
+             ENDIF
+             tend = 0.0_wp
+             CALL advec_s_bc( e, 'e' )
+
+          ENDIF
+       ENDIF
+
+!
+!--    TKE-tendency terms with no communication
+       IF ( scalar_advec /= 'bc-scheme'  .OR.  use_upstream_for_tke )  THEN
+          IF ( use_upstream_for_tke )  THEN
+             tend = 0.0_wp
+             CALL advec_s_up( e )
+          ELSE
+             tend = 0.0_wp
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( ws_scheme_sca )  THEN
+                   CALL advec_s_ws( e, 'e' )
+                ELSE 
+                   CALL advec_s_pw( e )
+                ENDIF
+             ELSE
+                CALL advec_s_up( e )
+             ENDIF
+          ENDIF
+       ENDIF
+
+       IF ( .NOT. humidity )  THEN
+          IF ( ocean )  THEN
+             CALL diffusion_e( prho, prho_reference )
+          ELSE
+             CALL diffusion_e( pt, pt_reference )
+          ENDIF
+       ELSE
+          CALL diffusion_e( vpt, pt_reference )
+       ENDIF
+
+       CALL production_e
+
+!
+!--    Additional sink term for flows through plant canopies
+       IF ( plant_canopy )  CALL pcm_tendency( 6 )
+       CALL user_actions( 'e-tendency' )
+
+!
+!--    Prognostic equation for TKE.
+!--    Eliminate negative TKE values, which can occur due to numerical
+!--    reasons in the course of the integration. In such cases the old TKE
+!--    value is reduced by 90%.
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                e_p(k,j,i) = e(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +          &
+                                                  tsc(3) * te_m(k,j,i) )
+                IF ( e_p(k,j,i) < 0.0_wp )  e_p(k,j,i) = 0.1_wp * e(k,j,i)
+             ENDDO
+          ENDDO
+       ENDDO
+
+!
+!--    Calculate tendencies for the next Runge-Kutta step
+       IF ( timestep_scheme(1:5) == 'runge' )  THEN
+          IF ( intermediate_timestep_count == 1 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      te_m(k,j,i) = tend(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ELSEIF ( intermediate_timestep_count < &
+                   intermediate_timestep_count_max )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb_s_inner(j,i)+1, nzt
+                      te_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * te_m(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+       ENDIF
+
+       CALL cpu_log( log_point(16), 'tke-equation', 'stop' )
+
+    ENDIF
+
+ END SUBROUTINE prognostic_equations_vector
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Version for accelerator boards
+!------------------------------------------------------------------------------!
+ 
+ SUBROUTINE prognostic_equations_acc
+
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i           !<
+    INTEGER(iwp) ::  j           !<
+    INTEGER(iwp) ::  k           !<
+    INTEGER(iwp) ::  runge_step  !<
+
+    REAL(wp)     ::  sbt         !<
+
+!
+!-- Set switch for intermediate Runge-Kutta step
+    runge_step = 0
+    IF ( timestep_scheme(1:5) == 'runge' )  THEN
+       IF ( intermediate_timestep_count == 1 )  THEN
+          runge_step = 1
+       ELSEIF ( intermediate_timestep_count < &
+                intermediate_timestep_count_max )  THEN
+          runge_step = 2
+       ENDIF
+    ENDIF
+
+!
+!-- If required, calculate cloud microphysical impacts (two-moment scheme)
+    IF ( cloud_physics  .AND.  .NOT. microphysics_sat_adjust  .AND.            &
+         ( intermediate_timestep_count == 1  .OR.                              &
+           call_microphysics_at_all_substeps )                                 &
+       )  THEN
+       CALL cpu_log( log_point(51), 'microphysics', 'start' )
+       CALL microphysics_control
+       CALL cpu_log( log_point(51), 'microphysics', 'stop' )
+    ENDIF
+
+!
+!-- u-velocity component
+!++ Statistics still not completely ported to accelerators
+    !$acc update device( hom, ref_state )
+    CALL cpu_log( log_point(5), 'u-equation', 'start' )
+
+    IF ( timestep_scheme(1:5) == 'runge' )  THEN
+       IF ( ws_scheme_mom )  THEN
+          CALL advec_u_ws_acc
+       ELSE
+          tend = 0.0_wp   ! to be removed later??
+          CALL advec_u_pw
+       ENDIF
+    ELSE
+       CALL advec_u_up
+    ENDIF
+    CALL diffusion_u_acc
+    CALL coriolis_acc( 1 )
+    IF ( sloping_surface  .AND.  .NOT. neutral )  THEN
+       CALL buoyancy( pt, 1 )
+    ENDIF
+
+!
+!-- Drag by plant canopy
+    IF ( plant_canopy )  CALL pcm_tendency( 1 )
+
+!
+!-- External pressure gradient
+    IF ( dp_external )  THEN
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+             DO  k = dp_level_ind_b+1, nzt
+                tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- Nudging
+    IF ( nudging )  CALL nudge( simulated_time, 'u' )
+
+    CALL user_actions( 'u-tendency' )
+
+!
+!-- Prognostic equation for u-velocity component
+    !$acc kernels present( nzb_u_inner, rdf, tend, tu_m, u, u_init, u_p )
+    !$acc loop independent
+    DO  i = i_left, i_right
+       !$acc loop independent
+       DO  j = j_south, j_north
+          !$acc loop independent
+          DO  k = 1, nzt
+             IF ( k > nzb_u_inner(j,i) )  THEN
+                u_p(k,j,i) = u(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
+                                                  tsc(3) * tu_m(k,j,i) )       &
+                                      - tsc(5) * rdf(k) * ( u(k,j,i) - u_init(k) )
+!
+!--             Tendencies for the next Runge-Kutta step
+                IF ( runge_step == 1 )  THEN
+                   tu_m(k,j,i) = tend(k,j,i)
+                ELSEIF ( runge_step == 2 )  THEN
+                   tu_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tu_m(k,j,i)
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDDO
+    !$acc end kernels
+
+    CALL cpu_log( log_point(5), 'u-equation', 'stop' )
+
+!
+!-- v-velocity component
+    CALL cpu_log( log_point(6), 'v-equation', 'start' )
+
+    IF ( timestep_scheme(1:5) == 'runge' )  THEN
+       IF ( ws_scheme_mom )  THEN
+          CALL advec_v_ws_acc
+       ELSE
+          tend = 0.0_wp    ! to be removed later??
+          CALL advec_v_pw
+       END IF
+    ELSE
+       CALL advec_v_up
+    ENDIF
+    CALL diffusion_v_acc
+    CALL coriolis_acc( 2 )
+
+!
+!-- Drag by plant canopy
+    IF ( plant_canopy )  CALL pcm_tendency( 2 )
+
+!
+!-- External pressure gradient
+    IF ( dp_external )  THEN
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+             DO  k = dp_level_ind_b+1, nzt
+                tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- Nudging
+    IF ( nudging )  CALL nudge( simulated_time, 'v' )
+
+    CALL user_actions( 'v-tendency' )
+
+!
+!-- Prognostic equation for v-velocity component
+    !$acc kernels present( nzb_v_inner, rdf, tend, tv_m, v, v_init, v_p )
+    !$acc loop independent
+    DO  i = i_left, i_right
+       !$acc loop independent
+       DO  j = j_south, j_north
+          !$acc loop independent
+          DO  k = 1, nzt
+             IF ( k > nzb_v_inner(j,i) )  THEN
+                v_p(k,j,i) = v(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
+                                                  tsc(3) * tv_m(k,j,i) )       &
+                                      - tsc(5) * rdf(k) * ( v(k,j,i) - v_init(k) )
+!
+!--             Tendencies for the next Runge-Kutta step
+                IF ( runge_step == 1 )  THEN
+                   tv_m(k,j,i) = tend(k,j,i)
+                ELSEIF ( runge_step == 2 )  THEN
+                   tv_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tv_m(k,j,i)
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDDO
+    !$acc end kernels
+
+    CALL cpu_log( log_point(6), 'v-equation', 'stop' )
+
+!
+!-- w-velocity component
+    CALL cpu_log( log_point(7), 'w-equation', 'start' )
+
+    IF ( timestep_scheme(1:5) == 'runge' )  THEN
+       IF ( ws_scheme_mom )  THEN
+          CALL advec_w_ws_acc
+       ELSE
+          tend = 0.0_wp    ! to be removed later??
+          CALL advec_w_pw
+       ENDIF
+    ELSE
+       CALL advec_w_up
+    ENDIF
+    CALL diffusion_w_acc
+    CALL coriolis_acc( 3 )
+
+    IF ( .NOT. neutral )  THEN
+       IF ( ocean )  THEN
+          CALL buoyancy( rho, 3 )
+       ELSE
+          IF ( .NOT. humidity )  THEN
+             CALL buoyancy_acc( pt, 3 )
+          ELSE
+             CALL buoyancy( vpt, 3 )
+          ENDIF
+       ENDIF
+    ENDIF
+
+!
+!-- Drag by plant canopy
+    IF ( plant_canopy )  CALL pcm_tendency( 3 )
+
+    CALL user_actions( 'w-tendency' )
+
+!
+!-- Prognostic equation for w-velocity component
+    !$acc kernels present( nzb_w_inner, rdf, tend, tw_m, w, w_p )
+    !$acc loop independent
+    DO  i = i_left, i_right
+       !$acc loop independent
+       DO  j = j_south, j_north
+          !$acc loop independent
+          DO  k = 1, nzt-1
+             IF ( k > nzb_w_inner(j,i) )  THEN
+                w_p(k,j,i) = w(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
+                                                  tsc(3) * tw_m(k,j,i) )       &
+                                      - tsc(5) * rdf(k) * w(k,j,i)
+   !
+   !--          Tendencies for the next Runge-Kutta step
+                IF ( runge_step == 1 )  THEN
+                   tw_m(k,j,i) = tend(k,j,i)
+                ELSEIF ( runge_step == 2 )  THEN
+                   tw_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tw_m(k,j,i)
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDDO
+    !$acc end kernels
+
+    CALL cpu_log( log_point(7), 'w-equation', 'stop' )
+
+
+!
+!-- If required, compute prognostic equation for potential temperature
+    IF ( .NOT. neutral )  THEN
+
+       CALL cpu_log( log_point(13), 'pt-equation', 'start' )
+
+!
+!--    pt-tendency terms with communication
+       sbt = tsc(2)
+       IF ( scalar_advec == 'bc-scheme' )  THEN
+
+          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--          Bott-Chlond scheme always uses Euler time step. Thus:
+             sbt = 1.0_wp
+          ENDIF
+          tend = 0.0_wp
+          CALL advec_s_bc( pt, 'pt' )
+
+       ENDIF
+
+!
+!--    pt-tendency terms with no communication
+       IF ( scalar_advec /= 'bc-scheme' )  THEN
+          tend = 0.0_wp
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+             IF ( ws_scheme_sca )  THEN
+                CALL advec_s_ws_acc( pt, 'pt' )
+             ELSE
+                tend = 0.0_wp    ! to be removed later??
+                CALL advec_s_pw( pt )
+             ENDIF
+          ELSE
+             CALL advec_s_up( pt )
+          ENDIF
+       ENDIF
+
+       CALL diffusion_s_acc( pt, shf, tswst, wall_heatflux )
+
+!
+!--    If required compute heating/cooling due to long wave radiation processes
+       IF ( cloud_top_radiation )  THEN
+          CALL calc_radiation
+       ENDIF
+
+!
+!--    Consideration of heat sources within the plant canopy
+       IF ( plant_canopy .AND. ( cthf /= 0.0_wp ) ) THEN
+          CALL pcm_tendency( 4 )
+       ENDIF
+
+!
+!--    Large scale advection
+       IF ( large_scale_forcing )  THEN
+          CALL ls_advec( simulated_time, 'pt' )
+       ENDIF
+
+!
+!--    Nudging
+       IF ( nudging )  CALL nudge( simulated_time, 'pt' ) 
+
+!
+!--    If required compute influence of large-scale subsidence/ascent
+       IF ( large_scale_subsidence  .AND.                                      &
+            .NOT. use_subsidence_tendencies )  THEN
+          CALL subsidence( tend, pt, pt_init, 2 )
+       ENDIF
+
+       IF ( radiation .AND. radiation_scheme == 'rrtmg' .AND.                  &
+            simulated_time > skip_time_do_radiation )  THEN
+            CALL radiation_tendency ( tend )
+       ENDIF
+
+       CALL user_actions( 'pt-tendency' )
+
+!
+!--    Prognostic equation for potential temperature
+       !$acc kernels present( nzb_s_inner, rdf_sc, ptdf_x, ptdf_y, pt_init ) &
+       !$acc         present( tend, tpt_m, pt, pt_p )
+       !$acc loop independent
+       DO  i = i_left, i_right
+          !$acc loop independent
+          DO  j = j_south, j_north
+             !$acc loop independent
+             DO  k = 1, nzt
+                IF ( k > nzb_s_inner(j,i) )  THEN
+                   pt_p(k,j,i) = pt(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +        &
+                                                       tsc(3) * tpt_m(k,j,i) )    &
+                                           - tsc(5) * ( pt(k,j,i) - pt_init(k) ) *&
+                                             ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) )
+!
+!--                Tendencies for the next Runge-Kutta step
+                   IF ( runge_step == 1 )  THEN
+                      tpt_m(k,j,i) = tend(k,j,i)
+                   ELSEIF ( runge_step == 2 )  THEN
+                      tpt_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tpt_m(k,j,i)
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+       !$acc end kernels
+
+       CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
+
+    ENDIF
+
+!
+!-- If required, compute prognostic equation for salinity
+    IF ( ocean )  THEN
+
+       CALL cpu_log( log_point(37), 'sa-equation', 'start' )
+
+!
+!--    sa-tendency terms with communication
+       sbt = tsc(2)
+       IF ( scalar_advec == 'bc-scheme' )  THEN
+
+          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--          Bott-Chlond scheme always uses Euler time step. Thus:
+             sbt = 1.0_wp
+          ENDIF
+          tend = 0.0_wp
+          CALL advec_s_bc( sa, 'sa' )
+
+       ENDIF
+
+!
+!--    sa-tendency terms with no communication
+       IF ( scalar_advec /= 'bc-scheme' )  THEN
+          tend = 0.0_wp
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+             IF ( ws_scheme_sca )  THEN
+                 CALL advec_s_ws( sa, 'sa' )
+             ELSE
+                 CALL advec_s_pw( sa )
+             ENDIF
+          ELSE
+             CALL advec_s_up( sa )
+          ENDIF
+       ENDIF
+
+       CALL diffusion_s( sa, saswsb, saswst, wall_salinityflux )
+
+       CALL user_actions( 'sa-tendency' )
+
+!
+!--    Prognostic equation for salinity
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                sa_p(k,j,i) = sa(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +        &
+                                                    tsc(3) * tsa_m(k,j,i) )    &
+                                        - tsc(5) * rdf_sc(k) *                 &
+                                          ( sa(k,j,i) - sa_init(k) )
+                IF ( sa_p(k,j,i) < 0.0_wp )  sa_p(k,j,i) = 0.1_wp * sa(k,j,i)
+!
+!--             Tendencies for the next Runge-Kutta step
+                IF ( runge_step == 1 )  THEN
+                   tsa_m(k,j,i) = tend(k,j,i)
+                ELSEIF ( runge_step == 2 )  THEN
+                   tsa_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tsa_m(k,j,i)
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+
+       CALL cpu_log( log_point(37), 'sa-equation', 'stop' )
+
+!
+!--    Calculate density by the equation of state for seawater
+       CALL cpu_log( log_point(38), 'eqns-seawater', 'start' )
+       CALL eqn_state_seawater
+       CALL cpu_log( log_point(38), 'eqns-seawater', 'stop' )
+
+    ENDIF
+
+!
+!-- If required, compute prognostic equation for total water content / scalar
+    IF ( humidity  .OR.  passive_scalar )  THEN
+
+       CALL cpu_log( log_point(29), 'q/s-equation', 'start' )
+
+!
+!--    Scalar/q-tendency terms with communication
+       sbt = tsc(2)
+       IF ( scalar_advec == 'bc-scheme' )  THEN
+
+          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--          Bott-Chlond scheme always uses Euler time step. Thus:
+             sbt = 1.0_wp
+          ENDIF
+          tend = 0.0_wp
+          CALL advec_s_bc( q, 'q' )
+
+       ENDIF
+
+!
+!--    Scalar/q-tendency terms with no communication
+       IF ( scalar_advec /= 'bc-scheme' )  THEN
+          tend = 0.0_wp
+          IF ( timestep_scheme(1:5) == 'runge' )  THEN
+             IF ( ws_scheme_sca )  THEN
+                CALL advec_s_ws( q, 'q' )
+             ELSE
+                CALL advec_s_pw( q )
+             ENDIF
+          ELSE
+             CALL advec_s_up( q )
+          ENDIF
+       ENDIF
+
+       CALL diffusion_s( q, qsws, qswst, wall_qflux )
+
+!
+!--    Sink or source of scalar concentration due to canopy elements
+       IF ( plant_canopy ) CALL pcm_tendency( 5 )
+
+!
+!--    Large scale advection
+       IF ( large_scale_forcing )  THEN
+          CALL ls_advec( simulated_time, 'q' )
+       ENDIF
+
+!
+!--    Nudging
+       IF ( nudging )  CALL nudge( simulated_time, 'q' ) 
+
+!
+!--    If required compute influence of large-scale subsidence/ascent
+       IF ( large_scale_subsidence  .AND.                                      &
+            .NOT. use_subsidence_tendencies )  THEN
+         CALL subsidence( tend, q, q_init, 3 )
+       ENDIF
+
+       CALL user_actions( 'q-tendency' )
+
+!
+!--    Prognostic equation for total water content / scalar
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+             DO  k = nzb_s_inner(j,i)+1, nzt
+                q_p(k,j,i) = q(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +          &
+                                                  tsc(3) * tq_m(k,j,i) )       &
+                                      - tsc(5) * rdf_sc(k) *                   &
+                                        ( q(k,j,i) - q_init(k) )
+                IF ( q_p(k,j,i) < 0.0_wp )  q_p(k,j,i) = 0.1_wp * q(k,j,i)
+!
+!--             Tendencies for the next Runge-Kutta step
+                IF ( runge_step == 1 )  THEN
+                   tq_m(k,j,i) = tend(k,j,i)
+                ELSEIF ( runge_step == 2 )  THEN
+                   tq_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tq_m(k,j,i)
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+
+       CALL cpu_log( log_point(29), 'q/s-equation', 'stop' )
+
+!
+!--    If required, calculate prognostic equations for rain water content 
+!--    and rain drop concentration
+       IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
+
+          CALL cpu_log( log_point(52), 'qr-equation', 'start' )
+!
+!--       qr-tendency terms with communication
+          sbt = tsc(2)
+          IF ( scalar_advec == 'bc-scheme' )  THEN
+
+             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--             Bott-Chlond scheme always uses Euler time step. Thus:
+                sbt = 1.0_wp
+             ENDIF
+             tend = 0.0_wp
+             CALL advec_s_bc( qr, 'qr' )
+
+          ENDIF
+
+!
+!--       qr-tendency terms with no communication
+          IF ( scalar_advec /= 'bc-scheme' )  THEN
+             tend = 0.0_wp
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( ws_scheme_sca )  THEN
+                   CALL advec_s_ws( qr, 'qr' )
+                ELSE
+                   CALL advec_s_pw( qr )
+                ENDIF
+             ELSE
+                CALL advec_s_up( qr )
+             ENDIF
+          ENDIF
+
+          CALL diffusion_s( qr, qrsws, qrswst, wall_qrflux )
+
+!
+!--       Prognostic equation for rain water content
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+                DO  k = nzb_s_inner(j,i)+1, nzt
+                   qr_p(k,j,i) = qr(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +     &
+                                                       tsc(3) * tqr_m(k,j,i) ) &
+                                           - tsc(5) * rdf_sc(k) * qr(k,j,i)
+                   IF ( qr_p(k,j,i) < 0.0_wp )  qr_p(k,j,i) = 0.0_wp
+!
+!--                Tendencies for the next Runge-Kutta step
+                   IF ( runge_step == 1 )  THEN
+                      tqr_m(k,j,i) = tend(k,j,i)
+                   ELSEIF ( runge_step == 2 )  THEN
+                      tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp *    &
+                                                                tqr_m(k,j,i)
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDDO
+
+          CALL cpu_log( log_point(52), 'qr-equation', 'stop' )
+          CALL cpu_log( log_point(53), 'nr-equation', 'start' )
+
+!
+!--       nr-tendency terms with communication
+          sbt = tsc(2)
+          IF ( scalar_advec == 'bc-scheme' )  THEN
+
+             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--             Bott-Chlond scheme always uses Euler time step. Thus:
+                sbt = 1.0_wp
+             ENDIF
+             tend = 0.0_wp
+             CALL advec_s_bc( nr, 'nr' )
+
+          ENDIF
+
+!
+!--       nr-tendency terms with no communication
+          IF ( scalar_advec /= 'bc-scheme' )  THEN
+             tend = 0.0_wp
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( ws_scheme_sca )  THEN
+                   CALL advec_s_ws( nr, 'nr' )
+                ELSE
+                   CALL advec_s_pw( nr )
+                ENDIF
+             ELSE
+                CALL advec_s_up( nr )
+             ENDIF
+          ENDIF
+
+          CALL diffusion_s( nr, nrsws, nrswst, wall_nrflux )
+
+!
+!--       Prognostic equation for rain drop concentration
+          DO  i = i_left, i_right
+             DO  j = j_south, j_north
+                DO  k = nzb_s_inner(j,i)+1, nzt
+                   nr_p(k,j,i) = nr(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +     &
+                                                       tsc(3) * tnr_m(k,j,i) ) &
+                                           - tsc(5) * rdf_sc(k) * nr(k,j,i)
+                   IF ( nr_p(k,j,i) < 0.0_wp )  nr_p(k,j,i) = 0.0_wp
+!
+!--                Tendencies for the next Runge-Kutta step
+                   IF ( runge_step == 1 )  THEN
+                      tnr_m(k,j,i) = tend(k,j,i)
+                   ELSEIF ( runge_step == 2 )  THEN
+                      tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp *    &
+                                                                tnr_m(k,j,i)
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDDO
+
+          CALL cpu_log( log_point(53), 'nr-equation', 'stop' )
+
+       ENDIF
+
+    ENDIF
+
+!
+!-- If required, compute prognostic equation for turbulent kinetic
+!-- energy (TKE)
+    IF ( .NOT. constant_diffusion )  THEN
+
+       CALL cpu_log( log_point(16), 'tke-equation', 'start' )
+
+       sbt = tsc(2)
+       IF ( .NOT. use_upstream_for_tke )  THEN
+          IF ( scalar_advec == 'bc-scheme' )  THEN
+
+             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--             Bott-Chlond scheme always uses Euler time step. Thus:
+                sbt = 1.0_wp
+             ENDIF
+             tend = 0.0_wp
+             CALL advec_s_bc( e, 'e' )
+
+          ENDIF
+       ENDIF
+
+!
+!--    TKE-tendency terms with no communication
+       IF ( scalar_advec /= 'bc-scheme'  .OR.  use_upstream_for_tke )  THEN
+          IF ( use_upstream_for_tke )  THEN
+             tend = 0.0_wp
+             CALL advec_s_up( e )
+          ELSE
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( ws_scheme_sca )  THEN
+                   CALL advec_s_ws_acc( e, 'e' )
+                ELSE
+                   tend = 0.0_wp    ! to be removed later??
+                   CALL advec_s_pw( e )
+                ENDIF
+             ELSE
+                tend = 0.0_wp    ! to be removed later??
+                CALL advec_s_up( e )
+             ENDIF
+          ENDIF
+       ENDIF
+
+       IF ( .NOT. humidity )  THEN
+          IF ( ocean )  THEN
+             CALL diffusion_e( prho, prho_reference )
+          ELSE
+             CALL diffusion_e_acc( pt, pt_reference )
+          ENDIF
+       ELSE
+          CALL diffusion_e( vpt, pt_reference )
+       ENDIF
+
+       CALL production_e_acc
+
+!
+!--    Additional sink term for flows through plant canopies
+       IF ( plant_canopy )  CALL pcm_tendency( 6 )
+       CALL user_actions( 'e-tendency' )
+
+!
+!--    Prognostic equation for TKE.
+!--    Eliminate negative TKE values, which can occur due to numerical
+!--    reasons in the course of the integration. In such cases the old TKE
+!--    value is reduced by 90%.
+       !$acc kernels present( e, e_p, nzb_s_inner, tend, te_m )
+       !$acc loop independent
+       DO  i = i_left, i_right
+          !$acc loop independent
+          DO  j = j_south, j_north
+             !$acc loop independent
+             DO  k = 1, nzt
+                IF ( k > nzb_s_inner(j,i) )  THEN
+                   e_p(k,j,i) = e(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +          &
+                                                     tsc(3) * te_m(k,j,i) )
+                   IF ( e_p(k,j,i) < 0.0_wp )  e_p(k,j,i) = 0.1_wp * e(k,j,i)
+!
+!--                Tendencies for the next Runge-Kutta step
+                   IF ( runge_step == 1 )  THEN
+                      te_m(k,j,i) = tend(k,j,i)
+                   ELSEIF ( runge_step == 2 )  THEN
+                      te_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * te_m(k,j,i)
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+       !$acc end kernels
+
+       CALL cpu_log( log_point(16), 'tke-equation', 'stop' )
+
+    ENDIF
+
+ END SUBROUTINE prognostic_equations_acc
+
+
+ END MODULE prognostic_equations_mod
Index: lm/trunk/SOURCE/prognostic_equations_mod.f90
===================================================================
--- /palm/trunk/SOURCE/prognostic_equations_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,2485 +1,0 @@
-!> @file prognostic_equations_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1826 2016-04-07 12:01:39Z maronga
-! Renamed canopy model calls.
-! 
-! 1822 2016-04-07 07:49:42Z hoffmann
-! Kessler microphysics scheme moved to microphysics.
-!
-! 1757 2016-02-22 15:49:32Z maronga
-! 
-! 
-! 1691 2015-10-26 16:17:44Z maronga
-! Added optional model spin-up without radiation / land surface model calls.
-! Formatting corrections.
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1585 2015-04-30 07:05:52Z maronga
-! Added call for temperature tendency calculation due to radiative flux divergence
-! 
-! 1517 2015-01-07 19:12:25Z hoffmann
-! advec_s_bc_mod addded, since advec_s_bc is now a module
-!
-! 1496 2014-12-02 17:25:50Z maronga
-! Renamed "radiation" -> "cloud_top_radiation"
-! 
-! 1484 2014-10-21 10:53:05Z kanani
-! Changes due to new module structure of the plant canopy model:
-!   parameters cthf and plant_canopy moved to module plant_canopy_model_mod.
-! Removed double-listing of use_upstream_for_tke in ONLY-list of module
-! control_parameters
-! 
-! 1409 2014-05-23 12:11:32Z suehring
-! Bugfix: i_omp_start changed for advec_u_ws at left inflow and outflow boundary. 
-! This ensures that left-hand side fluxes are also calculated for nxl in that
-! case, even though the solution at nxl is overwritten in boundary_conds() 
-! 
-! 1398 2014-05-07 11:15:00Z heinze
-! Rayleigh-damping for horizontal velocity components changed: instead of damping
-! against ug and vg, damping against u_init and v_init is used to allow for a 
-! homogenized treatment in case of nudging
-! 
-! 1380 2014-04-28 12:40:45Z heinze
-! Change order of calls for scalar prognostic quantities: 
-! ls_advec -> nudging -> subsidence since initial profiles 
-! 
-! 1374 2014-04-25 12:55:07Z raasch
-! missing variables added to ONLY lists
-! 
-! 1365 2014-04-22 15:03:56Z boeske
-! Calls of ls_advec for large scale advection added, 
-! subroutine subsidence is only called if use_subsidence_tendencies = .F.,
-! new argument ls_index added to the calls of subsidence
-! +ls_index
-! 
-! 1361 2014-04-16 15:17:48Z hoffmann
-! Two-moment microphysics moved to the start of prognostic equations. This makes
-! the 3d arrays for tend_q, tend_qr, tend_pt and tend_pt redundant.
-! Additionally, it is allowed to call the microphysics just once during the time
-! step (not at each sub-time step).
-!
-! Two-moment cloud physics added for vector and accelerator optimization.
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-! 
-! 1337 2014-03-25 15:11:48Z heinze
-! Bugfix: REAL constants provided with KIND-attribute
-! 
-! 1332 2014-03-25 11:59:43Z suehring
-! Bugfix: call advec_ws or advec_pw for TKE only if NOT use_upstream_for_tke 
-! 
-! 1330 2014-03-24 17:29:32Z suehring
-! In case of SGS-particle velocity advection of TKE is also allowed with 
-! dissipative 5th-order scheme.
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! old module precision_kind is removed,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1318 2014-03-17 13:35:16Z raasch
-! module interfaces removed
-!
-! 1257 2013-11-08 15:18:40Z raasch
-! openacc loop vector clauses removed, independent clauses added
-!
-! 1246 2013-11-01 08:59:45Z heinze
-! enable nudging also for accelerator version
-!
-! 1241 2013-10-30 11:36:58Z heinze
-! usage of nudging enabled (so far not implemented for accelerator version)
-!
-! 1179 2013-06-14 05:57:58Z raasch
-! two arguments removed from routine buoyancy, ref_state updated on device
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! those parts requiring global communication moved to time_integration,
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1115 2013-03-26 18:16:16Z hoffmann
-! optimized cloud physics: calculation of microphysical tendencies transfered 
-! to microphysics.f90; qr and nr are only calculated if precipitation is required
-!
-! 1111 2013-03-08 23:54:10Z raasch
-! update directives for prognostic quantities removed
-!
-! 1106 2013-03-04 05:31:38Z raasch
-! small changes in code formatting
-!
-! 1092 2013-02-02 11:24:22Z raasch
-! unused variables removed
-!
-! 1053 2012-11-13 17:11:03Z hoffmann
-! implementation of two new prognostic equations for rain drop concentration (nr)
-! and rain water content (qr)
-!
-! currently, only available for cache loop optimization
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1019 2012-09-28 06:46:45Z raasch
-! non-optimized version of prognostic_equations removed
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! new branch prognostic_equations_acc
-! OpenACC statements added + code changes required for GPU optimization
-!
-! 1001 2012-09-13 14:08:46Z raasch
-! all actions concerning leapfrog- and upstream-spline-scheme removed
-!
-! 978 2012-08-09 08:28:32Z fricke
-! km_damp_x and km_damp_y removed in calls of diffusion_u and diffusion_v
-! add ptdf_x, ptdf_y for damping the potential temperature at the inflow
-! boundary in case of non-cyclic lateral boundaries
-! Bugfix: first thread index changes for WS-scheme at the inflow
-!
-! 940 2012-07-09 14:31:00Z raasch
-! temperature equation can be switched off
-!
-! Revision 1.1  2000/04/13 14:56:27  schroeter
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Solving the prognostic equations.
-!------------------------------------------------------------------------------!
- MODULE prognostic_equations_mod
-
- 
-
-    USE arrays_3d,                                                             &
-        ONLY:  diss_l_e, diss_l_nr, diss_l_pt, diss_l_q, diss_l_qr,            &
-               diss_l_sa, diss_s_e, diss_s_nr, diss_s_pt, diss_s_q,            &
-               diss_s_qr, diss_s_sa, e, e_p, flux_s_e, flux_s_nr, flux_s_pt,   &
-               flux_s_q, flux_s_qr, flux_s_sa, flux_l_e, flux_l_nr,            &
-               flux_l_pt, flux_l_q, flux_l_qr, flux_l_sa, nr, nr_p, nrsws,     &
-               nrswst, pt, ptdf_x, ptdf_y, pt_init, pt_p, prho, q, q_init,     &
-               q_p, qsws, qswst, qr, qr_p, qrsws, qrswst, rdf, rdf_sc,         &
-               ref_state, rho, sa, sa_init, sa_p, saswsb, saswst, shf, tend,   &
-               te_m, tnr_m, tpt_m, tq_m, tqr_m, tsa_m, tswst, tu_m, tv_m,      &
-               tw_m, u, ug, u_init, u_p, v, vg, vpt, v_init, v_p, w, w_p
-        
-    USE control_parameters,                                                    &
-        ONLY:  call_microphysics_at_all_substeps, cloud_physics,               &
-               cloud_top_radiation, constant_diffusion, dp_external,           &
-               dp_level_ind_b, dp_smooth_factor, dpdxy, dt_3d, humidity,       &
-               inflow_l, intermediate_timestep_count,                          &
-               intermediate_timestep_count_max, large_scale_forcing,           &
-               large_scale_subsidence, microphysics_seifert,                   &
-               microphysics_sat_adjust, neutral, nudging, ocean, outflow_l,    &
-               outflow_s, passive_scalar, prho_reference, prho_reference,      &
-               prho_reference, pt_reference, pt_reference, pt_reference,       &
-               scalar_advec, scalar_advec, simulated_time, sloping_surface,    &
-               timestep_scheme, tsc, use_subsidence_tendencies,                &
-               use_upstream_for_tke, wall_heatflux,                            &
-               wall_nrflux, wall_qflux, wall_qflux, wall_qflux, wall_qrflux,   &
-               wall_salinityflux, ws_scheme_mom, ws_scheme_sca
-
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point
-
-    USE eqn_state_seawater_mod,                                                &
-        ONLY:  eqn_state_seawater
-
-    USE indices,                                                               &
-        ONLY:  i_left, i_right, j_north, j_south, nxl, nxlu, nxr, nyn, nys,    &
-               nysv, nzb_s_inner, nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
-
-    USE advec_ws,                                                              &
-        ONLY:  advec_s_ws, advec_s_ws_acc, advec_u_ws, advec_u_ws_acc,         &
-               advec_v_ws, advec_v_ws_acc, advec_w_ws, advec_w_ws_acc
-
-    USE advec_s_bc_mod,                                                        &
-        ONLY:  advec_s_bc
-
-    USE advec_s_pw_mod,                                                        &
-        ONLY:  advec_s_pw
-
-    USE advec_s_up_mod,                                                        &
-        ONLY:  advec_s_up
-
-    USE advec_u_pw_mod,                                                        &
-        ONLY:  advec_u_pw
-
-    USE advec_u_up_mod,                                                        &
-        ONLY:  advec_u_up
-
-    USE advec_v_pw_mod,                                                        &
-        ONLY:  advec_v_pw
-
-    USE advec_v_up_mod,                                                        &
-        ONLY:  advec_v_up
-
-    USE advec_w_pw_mod,                                                        &
-        ONLY:  advec_w_pw
-
-    USE advec_w_up_mod,                                                        &
-        ONLY:  advec_w_up
-
-    USE buoyancy_mod,                                                          &
-        ONLY:  buoyancy, buoyancy_acc
-
-    USE calc_radiation_mod,                                                    &
-        ONLY:  calc_radiation
-  
-    USE coriolis_mod,                                                          &
-        ONLY:  coriolis, coriolis_acc
-
-    USE diffusion_e_mod,                                                       &
-        ONLY:  diffusion_e, diffusion_e_acc
-
-    USE diffusion_s_mod,                                                       &
-        ONLY:  diffusion_s, diffusion_s_acc
-
-    USE diffusion_u_mod,                                                       &
-        ONLY:  diffusion_u, diffusion_u_acc
-
-    USE diffusion_v_mod,                                                       &
-        ONLY:  diffusion_v, diffusion_v_acc
-
-    USE diffusion_w_mod,                                                       &
-        ONLY:  diffusion_w, diffusion_w_acc
-
-    USE kinds
-
-    USE ls_forcing_mod,                                                        &
-        ONLY:  ls_advec
-
-    USE microphysics_mod,                                                      &
-        ONLY:  microphysics_control
-
-    USE nudge_mod,                                                             &
-        ONLY:  nudge
-
-    USE plant_canopy_model_mod,                                                &
-        ONLY:  cthf, plant_canopy, pcm_tendency
-
-    USE production_e_mod,                                                      &
-        ONLY:  production_e, production_e_acc
-
-    USE radiation_model_mod,                                                   &
-        ONLY:  radiation, radiation_scheme, radiation_tendency,                &
-               skip_time_do_radiation
-
-    USE statistics,                                                            &
-        ONLY:  hom
-
-    USE subsidence_mod,                                                        &
-        ONLY:  subsidence
-
-    USE user_actions_mod,                                                      &
-        ONLY:  user_actions
-
-
-    PRIVATE
-    PUBLIC prognostic_equations_cache, prognostic_equations_vector, &
-           prognostic_equations_acc
-
-    INTERFACE prognostic_equations_cache
-       MODULE PROCEDURE prognostic_equations_cache
-    END INTERFACE prognostic_equations_cache
-
-    INTERFACE prognostic_equations_vector
-       MODULE PROCEDURE prognostic_equations_vector
-    END INTERFACE prognostic_equations_vector
-
-    INTERFACE prognostic_equations_acc
-       MODULE PROCEDURE prognostic_equations_acc
-    END INTERFACE prognostic_equations_acc
-
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Version with one optimized loop over all equations. It is only allowed to
-!> be called for the Wicker and Skamarock or Piascek-Williams advection scheme.
-!>
-!> Here the calls of most subroutines are embedded in two DO loops over i and j,
-!> so communication between CPUs is not allowed (does not make sense) within
-!> these loops.
-!>
-!> (Optimized to avoid cache missings, i.e. for Power4/5-architectures.)
-!------------------------------------------------------------------------------!
- 
- SUBROUTINE prognostic_equations_cache
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i                   !<
-    INTEGER(iwp) ::  i_omp_start         !<
-    INTEGER(iwp) ::  j                   !<
-    INTEGER(iwp) ::  k                   !<
-    INTEGER(iwp) ::  omp_get_thread_num  !<
-    INTEGER(iwp) ::  tn = 0              !<
-    
-    LOGICAL      ::  loop_start          !<
-
-
-!
-!-- Time measurement can only be performed for the whole set of equations
-    CALL cpu_log( log_point(32), 'all progn.equations', 'start' )
-
-!
-!-- Loop over all prognostic equations
-!$OMP PARALLEL private (i,i_omp_start,j,k,loop_start,tn)
-
-!$  tn = omp_get_thread_num() 
-    loop_start = .TRUE.
-!$OMP DO
-    DO  i = nxl, nxr
-
-!
-!--    Store the first loop index. It differs for each thread and is required
-!--    later in advec_ws
-       IF ( loop_start )  THEN
-          loop_start  = .FALSE.
-          i_omp_start = i 
-       ENDIF
-
-       DO  j = nys, nyn
-!
-!--       If required, calculate cloud microphysics
-          IF ( cloud_physics  .AND.  .NOT. microphysics_sat_adjust  .AND.      &
-               ( intermediate_timestep_count == 1  .OR.                        &
-                 call_microphysics_at_all_substeps )                           &
-             )  THEN
-             CALL microphysics_control( i, j )
-          ENDIF
-!
-!--       Tendency terms for u-velocity component
-          IF ( .NOT. outflow_l  .OR.  i > nxl )  THEN
-
-             tend(:,j,i) = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( ws_scheme_mom )  THEN
-                   CALL advec_u_ws( i, j, i_omp_start, tn )
-                ELSE 
-                   CALL advec_u_pw( i, j )
-                ENDIF 
-             ELSE
-                CALL advec_u_up( i, j )
-             ENDIF
-             CALL diffusion_u( i, j )
-             CALL coriolis( i, j, 1 )
-             IF ( sloping_surface  .AND.  .NOT. neutral )  THEN
-                CALL buoyancy( i, j, pt, 1 )
-             ENDIF
-
-!
-!--          Drag by plant canopy
-             IF ( plant_canopy )  CALL pcm_tendency( i, j, 1 )
-
-!
-!--          External pressure gradient
-             IF ( dp_external )  THEN
-                DO  k = dp_level_ind_b+1, nzt
-                   tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
-                ENDDO
-             ENDIF
-
-!
-!--          Nudging
-             IF ( nudging )  CALL nudge( i, j, simulated_time, 'u' )
-
-             CALL user_actions( i, j, 'u-tendency' )
-!
-!--          Prognostic equation for u-velocity component
-             DO  k = nzb_u_inner(j,i)+1, nzt
-                u_p(k,j,i) = u(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
-                                                  tsc(3) * tu_m(k,j,i) )       &
-                                      - tsc(5) * rdf(k) * ( u(k,j,i) - u_init(k) )
-             ENDDO
-
-!
-!--          Calculate tendencies for the next Runge-Kutta step
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( intermediate_timestep_count == 1 )  THEN
-                   DO  k = nzb_u_inner(j,i)+1, nzt
-                      tu_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ELSEIF ( intermediate_timestep_count < &
-                         intermediate_timestep_count_max )  THEN
-                   DO  k = nzb_u_inner(j,i)+1, nzt
-                      tu_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tu_m(k,j,i)
-                   ENDDO
-                ENDIF
-             ENDIF
-
-          ENDIF
-
-!
-!--       Tendency terms for v-velocity component
-          IF ( .NOT. outflow_s  .OR.  j > nys )  THEN
-
-             tend(:,j,i) = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( ws_scheme_mom )  THEN
-                    CALL advec_v_ws( i, j, i_omp_start, tn )
-                ELSE 
-                    CALL advec_v_pw( i, j )
-                ENDIF
-             ELSE
-                CALL advec_v_up( i, j )
-             ENDIF
-             CALL diffusion_v( i, j )
-             CALL coriolis( i, j, 2 )
-
-!
-!--          Drag by plant canopy
-             IF ( plant_canopy )  CALL pcm_tendency( i, j, 2 )        
-
-!
-!--          External pressure gradient
-             IF ( dp_external )  THEN
-                DO  k = dp_level_ind_b+1, nzt
-                   tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
-                ENDDO
-             ENDIF
-
-!
-!--          Nudging
-             IF ( nudging )  CALL nudge( i, j, simulated_time, 'v' )
-
-             CALL user_actions( i, j, 'v-tendency' )
-!
-!--          Prognostic equation for v-velocity component
-             DO  k = nzb_v_inner(j,i)+1, nzt
-                v_p(k,j,i) = v(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
-                                                  tsc(3) * tv_m(k,j,i) )       &
-                                      - tsc(5) * rdf(k) * ( v(k,j,i) - v_init(k) )
-             ENDDO
-
-!
-!--          Calculate tendencies for the next Runge-Kutta step
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( intermediate_timestep_count == 1 )  THEN
-                   DO  k = nzb_v_inner(j,i)+1, nzt
-                      tv_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ELSEIF ( intermediate_timestep_count < &
-                         intermediate_timestep_count_max )  THEN
-                   DO  k = nzb_v_inner(j,i)+1, nzt
-                      tv_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tv_m(k,j,i)
-                   ENDDO
-                ENDIF
-             ENDIF
-
-          ENDIF
-
-!
-!--       Tendency terms for w-velocity component
-          tend(:,j,i) = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( ws_scheme_mom )  THEN
-                CALL advec_w_ws( i, j, i_omp_start, tn )
-             ELSE 
-                CALL advec_w_pw( i, j )
-             END IF
-          ELSE
-             CALL advec_w_up( i, j )
-          ENDIF
-          CALL diffusion_w( i, j )
-          CALL coriolis( i, j, 3 )
-
-          IF ( .NOT. neutral )  THEN
-             IF ( ocean )  THEN
-                CALL buoyancy( i, j, rho, 3 )
-             ELSE
-                IF ( .NOT. humidity )  THEN
-                   CALL buoyancy( i, j, pt, 3 )
-                ELSE
-                   CALL buoyancy( i, j, vpt, 3 )
-                ENDIF
-             ENDIF
-          ENDIF
-
-!
-!--       Drag by plant canopy
-          IF ( plant_canopy )  CALL pcm_tendency( i, j, 3 )
-
-          CALL user_actions( i, j, 'w-tendency' )
-
-!
-!--       Prognostic equation for w-velocity component
-          DO  k = nzb_w_inner(j,i)+1, nzt-1
-             w_p(k,j,i) = w(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +          &
-                                               tsc(3) * tw_m(k,j,i) )          &
-                                   - tsc(5) * rdf(k) * w(k,j,i)
-          ENDDO
-
-!
-!--       Calculate tendencies for the next Runge-Kutta step
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( intermediate_timestep_count == 1 )  THEN
-                DO  k = nzb_w_inner(j,i)+1, nzt-1
-                   tw_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  k = nzb_w_inner(j,i)+1, nzt-1
-                   tw_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tw_m(k,j,i)
-                ENDDO
-             ENDIF
-          ENDIF
-
-!
-!--       If required, compute prognostic equation for potential temperature
-          IF ( .NOT. neutral )  THEN
-!
-!--          Tendency terms for potential temperature
-             tend(:,j,i) = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                   IF ( ws_scheme_sca )  THEN
-                      CALL advec_s_ws( i, j, pt, 'pt', flux_s_pt, diss_s_pt, &
-                                       flux_l_pt, diss_l_pt, i_omp_start, tn )
-                   ELSE
-                      CALL advec_s_pw( i, j, pt )
-                   ENDIF
-             ELSE
-                CALL advec_s_up( i, j, pt )
-             ENDIF
-             CALL diffusion_s( i, j, pt, shf, tswst, wall_heatflux )
-
-!
-!--          If required compute heating/cooling due to long wave radiation
-!--          processes
-             IF ( cloud_top_radiation )  THEN
-                CALL calc_radiation( i, j )
-             ENDIF
-
-!
-!--          Consideration of heat sources within the plant canopy
-             IF ( plant_canopy  .AND.  cthf /= 0.0_wp )  THEN
-                CALL pcm_tendency( i, j, 4 )
-             ENDIF
-
-!
-!--          Large scale advection
-             IF ( large_scale_forcing )  THEN
-                CALL ls_advec( i, j, simulated_time, 'pt' )
-             ENDIF     
-
-!
-!--          Nudging
-             IF ( nudging )  CALL nudge( i, j, simulated_time, 'pt' ) 
-
-!
-!--          If required, compute effect of large-scale subsidence/ascent
-             IF ( large_scale_subsidence  .AND.                                &
-                  .NOT. use_subsidence_tendencies )  THEN
-                CALL subsidence( i, j, tend, pt, pt_init, 2 )
-             ENDIF
-
-!
-!--          If required, add tendency due to radiative heating/cooling
-             IF ( radiation .AND. radiation_scheme == 'rrtmg' .AND.            &
-                  simulated_time > skip_time_do_radiation )  THEN
-                CALL radiation_tendency ( i, j, tend )
-             ENDIF
-
-
-             CALL user_actions( i, j, 'pt-tendency' )
-
-!
-!--          Prognostic equation for potential temperature
-             DO  k = nzb_s_inner(j,i)+1, nzt
-                pt_p(k,j,i) = pt(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +     &
-                                                    tsc(3) * tpt_m(k,j,i) )    &
-                                        - tsc(5) * ( pt(k,j,i) - pt_init(k) ) *&
-                                          ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) )
-             ENDDO
-
-!
-!--          Calculate tendencies for the next Runge-Kutta step
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( intermediate_timestep_count == 1 )  THEN
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tpt_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ELSEIF ( intermediate_timestep_count < &
-                         intermediate_timestep_count_max )  THEN
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tpt_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
-                                      5.3125_wp * tpt_m(k,j,i)
-                   ENDDO
-                ENDIF
-             ENDIF
-
-          ENDIF
-
-!
-!--       If required, compute prognostic equation for salinity
-          IF ( ocean )  THEN
-
-!
-!--          Tendency-terms for salinity
-             tend(:,j,i) = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge' ) &
-             THEN
-                IF ( ws_scheme_sca )  THEN
-                    CALL advec_s_ws( i, j, sa, 'sa', flux_s_sa,  &
-                                diss_s_sa, flux_l_sa, diss_l_sa, i_omp_start, tn  )
-                ELSE 
-                    CALL advec_s_pw( i, j, sa )
-                ENDIF
-             ELSE
-                CALL advec_s_up( i, j, sa )
-             ENDIF
-             CALL diffusion_s( i, j, sa, saswsb, saswst, wall_salinityflux )
-
-             CALL user_actions( i, j, 'sa-tendency' )
-
-!
-!--          Prognostic equation for salinity
-             DO  k = nzb_s_inner(j,i)+1, nzt
-                sa_p(k,j,i) = sa(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +     &
-                                                    tsc(3) * tsa_m(k,j,i) )    &
-                                        - tsc(5) * rdf_sc(k) *                 &
-                                          ( sa(k,j,i) - sa_init(k) )
-                IF ( sa_p(k,j,i) < 0.0_wp )  sa_p(k,j,i) = 0.1_wp * sa(k,j,i)
-             ENDDO
-
-!
-!--          Calculate tendencies for the next Runge-Kutta step
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( intermediate_timestep_count == 1 )  THEN
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tsa_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ELSEIF ( intermediate_timestep_count < &
-                         intermediate_timestep_count_max )  THEN
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tsa_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
-                                      5.3125_wp * tsa_m(k,j,i)
-                   ENDDO
-                ENDIF
-             ENDIF
-
-!
-!--          Calculate density by the equation of state for seawater
-             CALL eqn_state_seawater( i, j )
-
-          ENDIF
-
-!
-!--       If required, compute prognostic equation for total water content /
-!--       scalar
-          IF ( humidity  .OR.  passive_scalar )  THEN
-
-!
-!--          Tendency-terms for total water content / scalar
-             tend(:,j,i) = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge' ) &
-             THEN
-                IF ( ws_scheme_sca )  THEN
-                   CALL advec_s_ws( i, j, q, 'q', flux_s_q, & 
-                                diss_s_q, flux_l_q, diss_l_q, i_omp_start, tn )
-                ELSE 
-                   CALL advec_s_pw( i, j, q )
-                ENDIF
-             ELSE
-                CALL advec_s_up( i, j, q )
-             ENDIF
-             CALL diffusion_s( i, j, q, qsws, qswst, wall_qflux )
-
-!
-!--          Sink or source of scalar concentration due to canopy elements
-             IF ( plant_canopy )  CALL pcm_tendency( i, j, 5 )
-
-!
-!--          Large scale advection
-             IF ( large_scale_forcing )  THEN
-                CALL ls_advec( i, j, simulated_time, 'q' )
-             ENDIF
-
-!
-!--          Nudging
-             IF ( nudging )  CALL nudge( i, j, simulated_time, 'q' ) 
-
-!
-!--          If required compute influence of large-scale subsidence/ascent
-             IF ( large_scale_subsidence  .AND.                                &
-                  .NOT. use_subsidence_tendencies )  THEN
-                CALL subsidence( i, j, tend, q, q_init, 3 )
-             ENDIF
-
-             CALL user_actions( i, j, 'q-tendency' )
-
-!
-!--          Prognostic equation for total water content / scalar
-             DO  k = nzb_s_inner(j,i)+1, nzt
-                q_p(k,j,i) = q(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
-                                                  tsc(3) * tq_m(k,j,i) )       &
-                                      - tsc(5) * rdf_sc(k) *                   &
-                                        ( q(k,j,i) - q_init(k) )
-                IF ( q_p(k,j,i) < 0.0_wp )  q_p(k,j,i) = 0.1_wp * q(k,j,i)
-             ENDDO
-
-!
-!--          Calculate tendencies for the next Runge-Kutta step
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( intermediate_timestep_count == 1 )  THEN
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tq_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ELSEIF ( intermediate_timestep_count < &
-                         intermediate_timestep_count_max )  THEN
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tq_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
-                                     5.3125_wp * tq_m(k,j,i)
-                   ENDDO
-                ENDIF
-             ENDIF
-
-!
-!--          If required, calculate prognostic equations for rain water content 
-!--          and rain drop concentration
-             IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
-!
-!--             Calculate prognostic equation for rain water content
-                tend(:,j,i) = 0.0_wp
-                IF ( timestep_scheme(1:5) == 'runge' ) &
-                THEN
-                   IF ( ws_scheme_sca )  THEN
-                      CALL advec_s_ws( i, j, qr, 'qr', flux_s_qr,       & 
-                                       diss_s_qr, flux_l_qr, diss_l_qr, &
-                                       i_omp_start, tn )
-                   ELSE 
-                      CALL advec_s_pw( i, j, qr )
-                   ENDIF
-                ELSE
-                   CALL advec_s_up( i, j, qr )
-                ENDIF
-                CALL diffusion_s( i, j, qr, qrsws, qrswst, wall_qrflux )
-
-!
-!--             Prognostic equation for rain water content
-                DO  k = nzb_s_inner(j,i)+1, nzt
-                   qr_p(k,j,i) = qr(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +  &
-                                                       tsc(3) * tqr_m(k,j,i) ) &
-                                           - tsc(5) * rdf_sc(k) * qr(k,j,i)
-                   IF ( qr_p(k,j,i) < 0.0_wp )  qr_p(k,j,i) = 0.0_wp
-                ENDDO
-!
-!--             Calculate tendencies for the next Runge-Kutta step
-                IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                   IF ( intermediate_timestep_count == 1 )  THEN
-                      DO  k = nzb_s_inner(j,i)+1, nzt
-                         tqr_m(k,j,i) = tend(k,j,i)
-                      ENDDO
-                   ELSEIF ( intermediate_timestep_count < &
-                            intermediate_timestep_count_max )  THEN
-                      DO  k = nzb_s_inner(j,i)+1, nzt
-                         tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
-                                        5.3125_wp * tqr_m(k,j,i)
-                      ENDDO
-                   ENDIF
-                ENDIF
-
-!
-!--             Calculate prognostic equation for rain drop concentration.
-                tend(:,j,i) = 0.0_wp
-                IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                   IF ( ws_scheme_sca )  THEN
-                      CALL advec_s_ws( i, j, nr, 'nr', flux_s_nr,    & 
-                                    diss_s_nr, flux_l_nr, diss_l_nr, &
-                                    i_omp_start, tn )
-                   ELSE 
-                      CALL advec_s_pw( i, j, nr )
-                   ENDIF
-                ELSE
-                   CALL advec_s_up( i, j, nr )
-                ENDIF
-                CALL diffusion_s( i, j, nr, nrsws, nrswst, wall_nrflux )
-
-!
-!--             Prognostic equation for rain drop concentration
-                DO  k = nzb_s_inner(j,i)+1, nzt
-                   nr_p(k,j,i) = nr(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +  &
-                                                       tsc(3) * tnr_m(k,j,i) ) &
-                                           - tsc(5) * rdf_sc(k) * nr(k,j,i)
-                   IF ( nr_p(k,j,i) < 0.0_wp )  nr_p(k,j,i) = 0.0_wp
-                ENDDO
-!
-!--             Calculate tendencies for the next Runge-Kutta step
-                IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                   IF ( intermediate_timestep_count == 1 )  THEN
-                      DO  k = nzb_s_inner(j,i)+1, nzt
-                         tnr_m(k,j,i) = tend(k,j,i)
-                      ENDDO
-                   ELSEIF ( intermediate_timestep_count < &
-                            intermediate_timestep_count_max )  THEN
-                      DO  k = nzb_s_inner(j,i)+1, nzt
-                         tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
-                                        5.3125_wp * tnr_m(k,j,i)
-                      ENDDO
-                   ENDIF
-                ENDIF
-
-             ENDIF
-
-          ENDIF
-
-!
-!--       If required, compute prognostic equation for turbulent kinetic 
-!--       energy (TKE)
-          IF ( .NOT. constant_diffusion )  THEN
-
-!
-!--          Tendency-terms for TKE
-             tend(:,j,i) = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge'  &
-                 .AND.  .NOT. use_upstream_for_tke )  THEN 
-                 IF ( ws_scheme_sca )  THEN
-                     CALL advec_s_ws( i, j, e, 'e', flux_s_e, diss_s_e, &
-                                      flux_l_e, diss_l_e , i_omp_start, tn )
-                 ELSE
-                     CALL advec_s_pw( i, j, e )
-                 ENDIF
-             ELSE
-                CALL advec_s_up( i, j, e )
-             ENDIF
-             IF ( .NOT. humidity )  THEN
-                IF ( ocean )  THEN
-                   CALL diffusion_e( i, j, prho, prho_reference )
-                ELSE
-                   CALL diffusion_e( i, j, pt, pt_reference )
-                ENDIF
-             ELSE
-                CALL diffusion_e( i, j, vpt, pt_reference )
-             ENDIF
-             CALL production_e( i, j )
-
-!
-!--          Additional sink term for flows through plant canopies
-             IF ( plant_canopy )  CALL pcm_tendency( i, j, 6 ) 
-
-             CALL user_actions( i, j, 'e-tendency' )
-
-!
-!--          Prognostic equation for TKE.
-!--          Eliminate negative TKE values, which can occur due to numerical
-!--          reasons in the course of the integration. In such cases the old
-!--          TKE value is reduced by 90%.
-             DO  k = nzb_s_inner(j,i)+1, nzt
-                e_p(k,j,i) = e(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
-                                                  tsc(3) * te_m(k,j,i) )
-                IF ( e_p(k,j,i) < 0.0_wp )  e_p(k,j,i) = 0.1_wp * e(k,j,i)
-             ENDDO
-
-!
-!--          Calculate tendencies for the next Runge-Kutta step
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( intermediate_timestep_count == 1 )  THEN
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      te_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ELSEIF ( intermediate_timestep_count < &
-                         intermediate_timestep_count_max )  THEN
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      te_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
-                                     5.3125_wp * te_m(k,j,i)
-                   ENDDO
-                ENDIF
-             ENDIF
-
-          ENDIF   ! TKE equation
-
-       ENDDO
-    ENDDO
-!$OMP END PARALLEL
-
-    CALL cpu_log( log_point(32), 'all progn.equations', 'stop' )
-
-
- END SUBROUTINE prognostic_equations_cache
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Version for vector machines
-!------------------------------------------------------------------------------!
- 
- SUBROUTINE prognostic_equations_vector
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i    !<
-    INTEGER(iwp) ::  j    !<
-    INTEGER(iwp) ::  k    !<
-
-    REAL(wp)     ::  sbt  !<
-
-
-!
-!-- If required, calculate cloud microphysical impacts
-    IF ( cloud_physics  .AND.  .NOT. microphysics_sat_adjust  .AND.            &
-         ( intermediate_timestep_count == 1  .OR.                              &
-           call_microphysics_at_all_substeps )                                 &
-       )  THEN
-       CALL cpu_log( log_point(51), 'microphysics', 'start' )
-       CALL microphysics_control
-       CALL cpu_log( log_point(51), 'microphysics', 'stop' )
-    ENDIF
-
-!
-!-- u-velocity component
-    CALL cpu_log( log_point(5), 'u-equation', 'start' )
-
-    tend = 0.0_wp
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_mom )  THEN
-          CALL advec_u_ws
-       ELSE
-          CALL advec_u_pw
-       ENDIF
-    ELSE
-       CALL advec_u_up
-    ENDIF
-    CALL diffusion_u
-    CALL coriolis( 1 )
-    IF ( sloping_surface  .AND.  .NOT. neutral )  THEN
-       CALL buoyancy( pt, 1 )
-    ENDIF
-
-!
-!-- Drag by plant canopy
-    IF ( plant_canopy )  CALL pcm_tendency( 1 )
-
-!
-!-- External pressure gradient
-    IF ( dp_external )  THEN
-       DO  i = nxlu, nxr
-          DO  j = nys, nyn
-             DO  k = dp_level_ind_b+1, nzt
-                tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
-!
-!-- Nudging
-    IF ( nudging )  CALL nudge( simulated_time, 'u' )
-
-    CALL user_actions( 'u-tendency' )
-
-!
-!-- Prognostic equation for u-velocity component
-    DO  i = nxlu, nxr
-       DO  j = nys, nyn
-          DO  k = nzb_u_inner(j,i)+1, nzt
-             u_p(k,j,i) = u(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +          &
-                                               tsc(3) * tu_m(k,j,i) )          &
-                                   - tsc(5) * rdf(k) * ( u(k,j,i) - u_init(k) )
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Calculate tendencies for the next Runge-Kutta step
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( intermediate_timestep_count == 1 )  THEN
-          DO  i = nxlu, nxr
-             DO  j = nys, nyn
-                DO  k = nzb_u_inner(j,i)+1, nzt
-                   tu_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ENDDO
-          ENDDO
-       ELSEIF ( intermediate_timestep_count < &
-                intermediate_timestep_count_max )  THEN
-          DO  i = nxlu, nxr
-             DO  j = nys, nyn
-                DO  k = nzb_u_inner(j,i)+1, nzt
-                   tu_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tu_m(k,j,i)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-
-    CALL cpu_log( log_point(5), 'u-equation', 'stop' )
-
-!
-!-- v-velocity component
-    CALL cpu_log( log_point(6), 'v-equation', 'start' )
-
-    tend = 0.0_wp
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_mom )  THEN
-          CALL advec_v_ws
-       ELSE 
-          CALL advec_v_pw
-       END IF
-    ELSE
-       CALL advec_v_up
-    ENDIF
-    CALL diffusion_v
-    CALL coriolis( 2 )
-
-!
-!-- Drag by plant canopy
-    IF ( plant_canopy )  CALL pcm_tendency( 2 )
-
-!
-!-- External pressure gradient
-    IF ( dp_external )  THEN
-       DO  i = nxl, nxr
-          DO  j = nysv, nyn
-             DO  k = dp_level_ind_b+1, nzt
-                tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
-!
-!-- Nudging
-    IF ( nudging )  CALL nudge( simulated_time, 'v' )
-
-    CALL user_actions( 'v-tendency' )
-
-!
-!-- Prognostic equation for v-velocity component
-    DO  i = nxl, nxr
-       DO  j = nysv, nyn
-          DO  k = nzb_v_inner(j,i)+1, nzt
-             v_p(k,j,i) = v(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +          &
-                                               tsc(3) * tv_m(k,j,i) )          &
-                                   - tsc(5) * rdf(k) * ( v(k,j,i) - v_init(k) )
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Calculate tendencies for the next Runge-Kutta step
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( intermediate_timestep_count == 1 )  THEN
-          DO  i = nxl, nxr
-             DO  j = nysv, nyn
-                DO  k = nzb_v_inner(j,i)+1, nzt
-                   tv_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ENDDO
-          ENDDO
-       ELSEIF ( intermediate_timestep_count < &
-                intermediate_timestep_count_max )  THEN
-          DO  i = nxl, nxr
-             DO  j = nysv, nyn
-                DO  k = nzb_v_inner(j,i)+1, nzt
-                   tv_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tv_m(k,j,i)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-
-    CALL cpu_log( log_point(6), 'v-equation', 'stop' )
-
-!
-!-- w-velocity component
-    CALL cpu_log( log_point(7), 'w-equation', 'start' )
-
-    tend = 0.0_wp
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_mom )  THEN
-          CALL advec_w_ws
-       ELSE
-          CALL advec_w_pw
-       ENDIF
-    ELSE
-       CALL advec_w_up
-    ENDIF
-    CALL diffusion_w
-    CALL coriolis( 3 )
-
-    IF ( .NOT. neutral )  THEN
-       IF ( ocean )  THEN
-          CALL buoyancy( rho, 3 )
-       ELSE
-          IF ( .NOT. humidity )  THEN
-             CALL buoyancy( pt, 3 )
-          ELSE
-             CALL buoyancy( vpt, 3 )
-          ENDIF
-       ENDIF
-    ENDIF
-
-!
-!-- Drag by plant canopy
-    IF ( plant_canopy )  CALL pcm_tendency( 3 )
-
-    CALL user_actions( 'w-tendency' )
-
-!
-!-- Prognostic equation for w-velocity component
-    DO  i = nxl, nxr
-       DO  j = nys, nyn
-          DO  k = nzb_w_inner(j,i)+1, nzt-1
-             w_p(k,j,i) = w(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +          &
-                                               tsc(3) * tw_m(k,j,i) )          &
-                                   - tsc(5) * rdf(k) * w(k,j,i)
-          ENDDO
-       ENDDO
-    ENDDO
-
-!
-!-- Calculate tendencies for the next Runge-Kutta step
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( intermediate_timestep_count == 1 )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb_w_inner(j,i)+1, nzt-1
-                   tw_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ENDDO
-          ENDDO
-       ELSEIF ( intermediate_timestep_count < &
-                intermediate_timestep_count_max )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb_w_inner(j,i)+1, nzt-1
-                   tw_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tw_m(k,j,i)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
-    ENDIF
-
-    CALL cpu_log( log_point(7), 'w-equation', 'stop' )
-
-
-!
-!-- If required, compute prognostic equation for potential temperature
-    IF ( .NOT. neutral )  THEN
-
-       CALL cpu_log( log_point(13), 'pt-equation', 'start' )
-
-!
-!--    pt-tendency terms with communication
-       sbt = tsc(2)
-       IF ( scalar_advec == 'bc-scheme' )  THEN
-
-          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--          Bott-Chlond scheme always uses Euler time step. Thus:
-             sbt = 1.0_wp
-          ENDIF
-          tend = 0.0_wp
-          CALL advec_s_bc( pt, 'pt' )
-
-       ENDIF
-
-!
-!--    pt-tendency terms with no communication
-       IF ( scalar_advec /= 'bc-scheme' )  THEN
-          tend = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws( pt, 'pt' )
-             ELSE
-                CALL advec_s_pw( pt )
-             ENDIF
-          ELSE
-             CALL advec_s_up( pt )
-          ENDIF
-       ENDIF
-
-       CALL diffusion_s( pt, shf, tswst, wall_heatflux )
-
-!
-!--    If required compute heating/cooling due to long wave radiation processes
-       IF ( cloud_top_radiation )  THEN
-          CALL calc_radiation
-       ENDIF
-
-!
-!--    Consideration of heat sources within the plant canopy
-       IF ( plant_canopy .AND. ( cthf /= 0.0_wp ) ) THEN
-          CALL pcm_tendency( 4 )
-       ENDIF
-
-!
-!--    Large scale advection
-       IF ( large_scale_forcing )  THEN
-          CALL ls_advec( simulated_time, 'pt' )
-       ENDIF
-
-!
-!--    Nudging
-       IF ( nudging )  CALL nudge( simulated_time, 'pt' ) 
-
-!
-!--    If required compute influence of large-scale subsidence/ascent
-       IF ( large_scale_subsidence  .AND.                                      &
-            .NOT. use_subsidence_tendencies )  THEN
-          CALL subsidence( tend, pt, pt_init, 2 )
-       ENDIF
-
-!
-!--    If required, add tendency due to radiative heating/cooling
-       IF ( radiation .AND. radiation_scheme == 'rrtmg' .AND.                  &
-            simulated_time > skip_time_do_radiation )  THEN
-            CALL radiation_tendency ( tend )
-       ENDIF
-
-       CALL user_actions( 'pt-tendency' )
-
-!
-!--    Prognostic equation for potential temperature
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_s_inner(j,i)+1, nzt
-                pt_p(k,j,i) = pt(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +        &
-                                                    tsc(3) * tpt_m(k,j,i) )    &
-                                        - tsc(5) * ( pt(k,j,i) - pt_init(k) ) *&
-                                          ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) )
-             ENDDO
-          ENDDO
-       ENDDO
-
-!
-!--    Calculate tendencies for the next Runge-Kutta step
-       IF ( timestep_scheme(1:5) == 'runge' )  THEN
-          IF ( intermediate_timestep_count == 1 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tpt_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSEIF ( intermediate_timestep_count < &
-                   intermediate_timestep_count_max )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tpt_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
-                                      5.3125_wp * tpt_m(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-
-       CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
-
-    ENDIF
-
-!
-!-- If required, compute prognostic equation for salinity
-    IF ( ocean )  THEN
-
-       CALL cpu_log( log_point(37), 'sa-equation', 'start' )
-
-!
-!--    sa-tendency terms with communication
-       sbt = tsc(2)
-       IF ( scalar_advec == 'bc-scheme' )  THEN
-
-          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--          Bott-Chlond scheme always uses Euler time step. Thus:
-             sbt = 1.0_wp
-          ENDIF
-          tend = 0.0_wp
-          CALL advec_s_bc( sa, 'sa' )
-
-       ENDIF
-
-!
-!--    sa-tendency terms with no communication
-       IF ( scalar_advec /= 'bc-scheme' )  THEN
-          tend = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( ws_scheme_sca )  THEN
-                 CALL advec_s_ws( sa, 'sa' )
-             ELSE
-                 CALL advec_s_pw( sa )
-             ENDIF
-          ELSE
-             CALL advec_s_up( sa )
-          ENDIF
-       ENDIF
-
-       CALL diffusion_s( sa, saswsb, saswst, wall_salinityflux )
-       
-       CALL user_actions( 'sa-tendency' )
-
-!
-!--    Prognostic equation for salinity
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_s_inner(j,i)+1, nzt
-                sa_p(k,j,i) = sa(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +        &
-                                                    tsc(3) * tsa_m(k,j,i) )    &
-                                        - tsc(5) * rdf_sc(k) *                 &
-                                          ( sa(k,j,i) - sa_init(k) )
-                IF ( sa_p(k,j,i) < 0.0_wp )  sa_p(k,j,i) = 0.1_wp * sa(k,j,i)
-             ENDDO
-          ENDDO
-       ENDDO
-
-!
-!--    Calculate tendencies for the next Runge-Kutta step
-       IF ( timestep_scheme(1:5) == 'runge' )  THEN
-          IF ( intermediate_timestep_count == 1 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tsa_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSEIF ( intermediate_timestep_count < &
-                   intermediate_timestep_count_max )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tsa_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
-                                      5.3125_wp * tsa_m(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-
-       CALL cpu_log( log_point(37), 'sa-equation', 'stop' )
-
-!
-!--    Calculate density by the equation of state for seawater
-       CALL cpu_log( log_point(38), 'eqns-seawater', 'start' )
-       CALL eqn_state_seawater
-       CALL cpu_log( log_point(38), 'eqns-seawater', 'stop' )
-
-    ENDIF
-
-!
-!-- If required, compute prognostic equation for total water content / scalar
-    IF ( humidity  .OR.  passive_scalar )  THEN
-
-       CALL cpu_log( log_point(29), 'q/s-equation', 'start' )
-
-!
-!--    Scalar/q-tendency terms with communication
-       sbt = tsc(2)
-       IF ( scalar_advec == 'bc-scheme' )  THEN
-
-          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--          Bott-Chlond scheme always uses Euler time step. Thus:
-             sbt = 1.0_wp
-          ENDIF
-          tend = 0.0_wp
-          CALL advec_s_bc( q, 'q' )
-
-       ENDIF
-
-!
-!--    Scalar/q-tendency terms with no communication
-       IF ( scalar_advec /= 'bc-scheme' )  THEN
-          tend = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws( q, 'q' )
-             ELSE
-                CALL advec_s_pw( q )
-             ENDIF
-          ELSE
-             CALL advec_s_up( q )
-          ENDIF
-       ENDIF
-
-       CALL diffusion_s( q, qsws, qswst, wall_qflux )
-       
-!
-!--    Sink or source of scalar concentration due to canopy elements
-       IF ( plant_canopy ) CALL pcm_tendency( 5 )
-
-!
-!--    Large scale advection
-       IF ( large_scale_forcing )  THEN
-          CALL ls_advec( simulated_time, 'q' )
-       ENDIF
-
-!
-!--    Nudging
-       IF ( nudging )  CALL nudge( simulated_time, 'q' ) 
-
-!
-!--    If required compute influence of large-scale subsidence/ascent
-       IF ( large_scale_subsidence  .AND.                                      &
-            .NOT. use_subsidence_tendencies )  THEN
-         CALL subsidence( tend, q, q_init, 3 )
-       ENDIF
-
-       CALL user_actions( 'q-tendency' )
-
-!
-!--    Prognostic equation for total water content / scalar
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_s_inner(j,i)+1, nzt
-                q_p(k,j,i) = q(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +          &
-                                                  tsc(3) * tq_m(k,j,i) )       &
-                                      - tsc(5) * rdf_sc(k) *                   &
-                                        ( q(k,j,i) - q_init(k) )
-                IF ( q_p(k,j,i) < 0.0_wp )  q_p(k,j,i) = 0.1_wp * q(k,j,i)
-             ENDDO
-          ENDDO
-       ENDDO
-
-!
-!--    Calculate tendencies for the next Runge-Kutta step
-       IF ( timestep_scheme(1:5) == 'runge' )  THEN
-          IF ( intermediate_timestep_count == 1 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tq_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSEIF ( intermediate_timestep_count < &
-                   intermediate_timestep_count_max )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      tq_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tq_m(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-
-       CALL cpu_log( log_point(29), 'q/s-equation', 'stop' )
-
-!
-!--    If required, calculate prognostic equations for rain water content 
-!--    and rain drop concentration
-       IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
-
-          CALL cpu_log( log_point(52), 'qr-equation', 'start' )
-
-!
-!--       Calculate prognostic equation for rain water content
-          sbt = tsc(2)
-          IF ( scalar_advec == 'bc-scheme' )  THEN
-
-             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--             Bott-Chlond scheme always uses Euler time step. Thus:
-                sbt = 1.0_wp
-             ENDIF
-             tend = 0.0_wp
-             CALL advec_s_bc( qr, 'qr' )
-
-          ENDIF
-
-!
-!--       qr-tendency terms with no communication
-          IF ( scalar_advec /= 'bc-scheme' )  THEN
-             tend = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( ws_scheme_sca )  THEN
-                   CALL advec_s_ws( qr, 'qr' )
-                ELSE
-                   CALL advec_s_pw( qr )
-                ENDIF
-             ELSE
-                CALL advec_s_up( qr )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( qr, qrsws, qrswst, wall_qrflux )
-
-          CALL user_actions( 'qr-tendency' )
-
-!
-!--       Prognostic equation for rain water content
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb_s_inner(j,i)+1, nzt
-                   qr_p(k,j,i) = qr(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +     &
-                                                     tsc(3) * tqr_m(k,j,i) )   &
-                                           - tsc(5) * rdf_sc(k) * qr(k,j,i)
-                   IF ( qr_p(k,j,i) < 0.0_wp )  qr_p(k,j,i) = 0.0_wp
-                ENDDO
-             ENDDO
-          ENDDO
-
-!
-!--       Calculate tendencies for the next Runge-Kutta step
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( intermediate_timestep_count == 1 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_s_inner(j,i)+1, nzt
-                         tqr_m(k,j,i) = tend(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_s_inner(j,i)+1, nzt
-                         tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * &
-                                                                   tqr_m(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-
-          CALL cpu_log( log_point(52), 'qr-equation', 'stop' )
-          CALL cpu_log( log_point(53), 'nr-equation', 'start' )
-
-!
-!--       Calculate prognostic equation for rain drop concentration
-          sbt = tsc(2)
-          IF ( scalar_advec == 'bc-scheme' )  THEN
-
-             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--             Bott-Chlond scheme always uses Euler time step. Thus:
-                sbt = 1.0_wp
-             ENDIF
-             tend = 0.0_wp
-             CALL advec_s_bc( nr, 'nr' )
-
-          ENDIF
-
-!
-!--       nr-tendency terms with no communication
-          IF ( scalar_advec /= 'bc-scheme' )  THEN
-             tend = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( ws_scheme_sca )  THEN
-                   CALL advec_s_ws( nr, 'nr' )
-                ELSE
-                   CALL advec_s_pw( nr )
-                ENDIF
-             ELSE
-                CALL advec_s_up( nr )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( nr, nrsws, nrswst, wall_nrflux )
-
-!
-!--       Prognostic equation for rain drop concentration
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb_s_inner(j,i)+1, nzt
-                   nr_p(k,j,i) = nr(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +     &
-                                                     tsc(3) * tnr_m(k,j,i) )   &
-                                           - tsc(5) * rdf_sc(k) * nr(k,j,i)
-                   IF ( nr_p(k,j,i) < 0.0_wp )  nr_p(k,j,i) = 0.0_wp
-                ENDDO
-             ENDDO
-          ENDDO
-
-!
-!--       Calculate tendencies for the next Runge-Kutta step
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( intermediate_timestep_count == 1 )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_s_inner(j,i)+1, nzt
-                         tnr_m(k,j,i) = tend(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ELSEIF ( intermediate_timestep_count < &
-                      intermediate_timestep_count_max )  THEN
-                DO  i = nxl, nxr
-                   DO  j = nys, nyn
-                      DO  k = nzb_s_inner(j,i)+1, nzt
-                         tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * &
-                                                                   tnr_m(k,j,i)
-                      ENDDO
-                   ENDDO
-                ENDDO
-             ENDIF
-          ENDIF
-
-          CALL cpu_log( log_point(53), 'nr-equation', 'stop' )
-
-       ENDIF
-
-    ENDIF
-
-!
-!-- If required, compute prognostic equation for turbulent kinetic 
-!-- energy (TKE)
-    IF ( .NOT. constant_diffusion )  THEN
-
-       CALL cpu_log( log_point(16), 'tke-equation', 'start' )
-
-       sbt = tsc(2)
-       IF ( .NOT. use_upstream_for_tke )  THEN
-          IF ( scalar_advec == 'bc-scheme' )  THEN
-
-             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--             Bott-Chlond scheme always uses Euler time step. Thus:
-                sbt = 1.0_wp
-             ENDIF
-             tend = 0.0_wp
-             CALL advec_s_bc( e, 'e' )
-
-          ENDIF
-       ENDIF
-
-!
-!--    TKE-tendency terms with no communication
-       IF ( scalar_advec /= 'bc-scheme'  .OR.  use_upstream_for_tke )  THEN
-          IF ( use_upstream_for_tke )  THEN
-             tend = 0.0_wp
-             CALL advec_s_up( e )
-          ELSE
-             tend = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( ws_scheme_sca )  THEN
-                   CALL advec_s_ws( e, 'e' )
-                ELSE 
-                   CALL advec_s_pw( e )
-                ENDIF
-             ELSE
-                CALL advec_s_up( e )
-             ENDIF
-          ENDIF
-       ENDIF
-
-       IF ( .NOT. humidity )  THEN
-          IF ( ocean )  THEN
-             CALL diffusion_e( prho, prho_reference )
-          ELSE
-             CALL diffusion_e( pt, pt_reference )
-          ENDIF
-       ELSE
-          CALL diffusion_e( vpt, pt_reference )
-       ENDIF
-
-       CALL production_e
-
-!
-!--    Additional sink term for flows through plant canopies
-       IF ( plant_canopy )  CALL pcm_tendency( 6 )
-       CALL user_actions( 'e-tendency' )
-
-!
-!--    Prognostic equation for TKE.
-!--    Eliminate negative TKE values, which can occur due to numerical
-!--    reasons in the course of the integration. In such cases the old TKE
-!--    value is reduced by 90%.
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb_s_inner(j,i)+1, nzt
-                e_p(k,j,i) = e(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +          &
-                                                  tsc(3) * te_m(k,j,i) )
-                IF ( e_p(k,j,i) < 0.0_wp )  e_p(k,j,i) = 0.1_wp * e(k,j,i)
-             ENDDO
-          ENDDO
-       ENDDO
-
-!
-!--    Calculate tendencies for the next Runge-Kutta step
-       IF ( timestep_scheme(1:5) == 'runge' )  THEN
-          IF ( intermediate_timestep_count == 1 )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      te_m(k,j,i) = tend(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ELSEIF ( intermediate_timestep_count < &
-                   intermediate_timestep_count_max )  THEN
-             DO  i = nxl, nxr
-                DO  j = nys, nyn
-                   DO  k = nzb_s_inner(j,i)+1, nzt
-                      te_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * te_m(k,j,i)
-                   ENDDO
-                ENDDO
-             ENDDO
-          ENDIF
-       ENDIF
-
-       CALL cpu_log( log_point(16), 'tke-equation', 'stop' )
-
-    ENDIF
-
- END SUBROUTINE prognostic_equations_vector
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Version for accelerator boards
-!------------------------------------------------------------------------------!
- 
- SUBROUTINE prognostic_equations_acc
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i           !<
-    INTEGER(iwp) ::  j           !<
-    INTEGER(iwp) ::  k           !<
-    INTEGER(iwp) ::  runge_step  !<
-
-    REAL(wp)     ::  sbt         !<
-
-!
-!-- Set switch for intermediate Runge-Kutta step
-    runge_step = 0
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( intermediate_timestep_count == 1 )  THEN
-          runge_step = 1
-       ELSEIF ( intermediate_timestep_count < &
-                intermediate_timestep_count_max )  THEN
-          runge_step = 2
-       ENDIF
-    ENDIF
-
-!
-!-- If required, calculate cloud microphysical impacts (two-moment scheme)
-    IF ( cloud_physics  .AND.  .NOT. microphysics_sat_adjust  .AND.            &
-         ( intermediate_timestep_count == 1  .OR.                              &
-           call_microphysics_at_all_substeps )                                 &
-       )  THEN
-       CALL cpu_log( log_point(51), 'microphysics', 'start' )
-       CALL microphysics_control
-       CALL cpu_log( log_point(51), 'microphysics', 'stop' )
-    ENDIF
-
-!
-!-- u-velocity component
-!++ Statistics still not completely ported to accelerators
-    !$acc update device( hom, ref_state )
-    CALL cpu_log( log_point(5), 'u-equation', 'start' )
-
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_mom )  THEN
-          CALL advec_u_ws_acc
-       ELSE
-          tend = 0.0_wp   ! to be removed later??
-          CALL advec_u_pw
-       ENDIF
-    ELSE
-       CALL advec_u_up
-    ENDIF
-    CALL diffusion_u_acc
-    CALL coriolis_acc( 1 )
-    IF ( sloping_surface  .AND.  .NOT. neutral )  THEN
-       CALL buoyancy( pt, 1 )
-    ENDIF
-
-!
-!-- Drag by plant canopy
-    IF ( plant_canopy )  CALL pcm_tendency( 1 )
-
-!
-!-- External pressure gradient
-    IF ( dp_external )  THEN
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-             DO  k = dp_level_ind_b+1, nzt
-                tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
-!
-!-- Nudging
-    IF ( nudging )  CALL nudge( simulated_time, 'u' )
-
-    CALL user_actions( 'u-tendency' )
-
-!
-!-- Prognostic equation for u-velocity component
-    !$acc kernels present( nzb_u_inner, rdf, tend, tu_m, u, u_init, u_p )
-    !$acc loop independent
-    DO  i = i_left, i_right
-       !$acc loop independent
-       DO  j = j_south, j_north
-          !$acc loop independent
-          DO  k = 1, nzt
-             IF ( k > nzb_u_inner(j,i) )  THEN
-                u_p(k,j,i) = u(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
-                                                  tsc(3) * tu_m(k,j,i) )       &
-                                      - tsc(5) * rdf(k) * ( u(k,j,i) - u_init(k) )
-!
-!--             Tendencies for the next Runge-Kutta step
-                IF ( runge_step == 1 )  THEN
-                   tu_m(k,j,i) = tend(k,j,i)
-                ELSEIF ( runge_step == 2 )  THEN
-                   tu_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tu_m(k,j,i)
-                ENDIF
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-    !$acc end kernels
-
-    CALL cpu_log( log_point(5), 'u-equation', 'stop' )
-
-!
-!-- v-velocity component
-    CALL cpu_log( log_point(6), 'v-equation', 'start' )
-
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_mom )  THEN
-          CALL advec_v_ws_acc
-       ELSE
-          tend = 0.0_wp    ! to be removed later??
-          CALL advec_v_pw
-       END IF
-    ELSE
-       CALL advec_v_up
-    ENDIF
-    CALL diffusion_v_acc
-    CALL coriolis_acc( 2 )
-
-!
-!-- Drag by plant canopy
-    IF ( plant_canopy )  CALL pcm_tendency( 2 )
-
-!
-!-- External pressure gradient
-    IF ( dp_external )  THEN
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-             DO  k = dp_level_ind_b+1, nzt
-                tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
-!
-!-- Nudging
-    IF ( nudging )  CALL nudge( simulated_time, 'v' )
-
-    CALL user_actions( 'v-tendency' )
-
-!
-!-- Prognostic equation for v-velocity component
-    !$acc kernels present( nzb_v_inner, rdf, tend, tv_m, v, v_init, v_p )
-    !$acc loop independent
-    DO  i = i_left, i_right
-       !$acc loop independent
-       DO  j = j_south, j_north
-          !$acc loop independent
-          DO  k = 1, nzt
-             IF ( k > nzb_v_inner(j,i) )  THEN
-                v_p(k,j,i) = v(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
-                                                  tsc(3) * tv_m(k,j,i) )       &
-                                      - tsc(5) * rdf(k) * ( v(k,j,i) - v_init(k) )
-!
-!--             Tendencies for the next Runge-Kutta step
-                IF ( runge_step == 1 )  THEN
-                   tv_m(k,j,i) = tend(k,j,i)
-                ELSEIF ( runge_step == 2 )  THEN
-                   tv_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tv_m(k,j,i)
-                ENDIF
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-    !$acc end kernels
-
-    CALL cpu_log( log_point(6), 'v-equation', 'stop' )
-
-!
-!-- w-velocity component
-    CALL cpu_log( log_point(7), 'w-equation', 'start' )
-
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_mom )  THEN
-          CALL advec_w_ws_acc
-       ELSE
-          tend = 0.0_wp    ! to be removed later??
-          CALL advec_w_pw
-       ENDIF
-    ELSE
-       CALL advec_w_up
-    ENDIF
-    CALL diffusion_w_acc
-    CALL coriolis_acc( 3 )
-
-    IF ( .NOT. neutral )  THEN
-       IF ( ocean )  THEN
-          CALL buoyancy( rho, 3 )
-       ELSE
-          IF ( .NOT. humidity )  THEN
-             CALL buoyancy_acc( pt, 3 )
-          ELSE
-             CALL buoyancy( vpt, 3 )
-          ENDIF
-       ENDIF
-    ENDIF
-
-!
-!-- Drag by plant canopy
-    IF ( plant_canopy )  CALL pcm_tendency( 3 )
-
-    CALL user_actions( 'w-tendency' )
-
-!
-!-- Prognostic equation for w-velocity component
-    !$acc kernels present( nzb_w_inner, rdf, tend, tw_m, w, w_p )
-    !$acc loop independent
-    DO  i = i_left, i_right
-       !$acc loop independent
-       DO  j = j_south, j_north
-          !$acc loop independent
-          DO  k = 1, nzt-1
-             IF ( k > nzb_w_inner(j,i) )  THEN
-                w_p(k,j,i) = w(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) +       &
-                                                  tsc(3) * tw_m(k,j,i) )       &
-                                      - tsc(5) * rdf(k) * w(k,j,i)
-   !
-   !--          Tendencies for the next Runge-Kutta step
-                IF ( runge_step == 1 )  THEN
-                   tw_m(k,j,i) = tend(k,j,i)
-                ELSEIF ( runge_step == 2 )  THEN
-                   tw_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tw_m(k,j,i)
-                ENDIF
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-    !$acc end kernels
-
-    CALL cpu_log( log_point(7), 'w-equation', 'stop' )
-
-
-!
-!-- If required, compute prognostic equation for potential temperature
-    IF ( .NOT. neutral )  THEN
-
-       CALL cpu_log( log_point(13), 'pt-equation', 'start' )
-
-!
-!--    pt-tendency terms with communication
-       sbt = tsc(2)
-       IF ( scalar_advec == 'bc-scheme' )  THEN
-
-          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--          Bott-Chlond scheme always uses Euler time step. Thus:
-             sbt = 1.0_wp
-          ENDIF
-          tend = 0.0_wp
-          CALL advec_s_bc( pt, 'pt' )
-
-       ENDIF
-
-!
-!--    pt-tendency terms with no communication
-       IF ( scalar_advec /= 'bc-scheme' )  THEN
-          tend = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws_acc( pt, 'pt' )
-             ELSE
-                tend = 0.0_wp    ! to be removed later??
-                CALL advec_s_pw( pt )
-             ENDIF
-          ELSE
-             CALL advec_s_up( pt )
-          ENDIF
-       ENDIF
-
-       CALL diffusion_s_acc( pt, shf, tswst, wall_heatflux )
-
-!
-!--    If required compute heating/cooling due to long wave radiation processes
-       IF ( cloud_top_radiation )  THEN
-          CALL calc_radiation
-       ENDIF
-
-!
-!--    Consideration of heat sources within the plant canopy
-       IF ( plant_canopy .AND. ( cthf /= 0.0_wp ) ) THEN
-          CALL pcm_tendency( 4 )
-       ENDIF
-
-!
-!--    Large scale advection
-       IF ( large_scale_forcing )  THEN
-          CALL ls_advec( simulated_time, 'pt' )
-       ENDIF
-
-!
-!--    Nudging
-       IF ( nudging )  CALL nudge( simulated_time, 'pt' ) 
-
-!
-!--    If required compute influence of large-scale subsidence/ascent
-       IF ( large_scale_subsidence  .AND.                                      &
-            .NOT. use_subsidence_tendencies )  THEN
-          CALL subsidence( tend, pt, pt_init, 2 )
-       ENDIF
-
-       IF ( radiation .AND. radiation_scheme == 'rrtmg' .AND.                  &
-            simulated_time > skip_time_do_radiation )  THEN
-            CALL radiation_tendency ( tend )
-       ENDIF
-
-       CALL user_actions( 'pt-tendency' )
-
-!
-!--    Prognostic equation for potential temperature
-       !$acc kernels present( nzb_s_inner, rdf_sc, ptdf_x, ptdf_y, pt_init ) &
-       !$acc         present( tend, tpt_m, pt, pt_p )
-       !$acc loop independent
-       DO  i = i_left, i_right
-          !$acc loop independent
-          DO  j = j_south, j_north
-             !$acc loop independent
-             DO  k = 1, nzt
-                IF ( k > nzb_s_inner(j,i) )  THEN
-                   pt_p(k,j,i) = pt(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +        &
-                                                       tsc(3) * tpt_m(k,j,i) )    &
-                                           - tsc(5) * ( pt(k,j,i) - pt_init(k) ) *&
-                                             ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) )
-!
-!--                Tendencies for the next Runge-Kutta step
-                   IF ( runge_step == 1 )  THEN
-                      tpt_m(k,j,i) = tend(k,j,i)
-                   ELSEIF ( runge_step == 2 )  THEN
-                      tpt_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tpt_m(k,j,i)
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-       !$acc end kernels
-
-       CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
-
-    ENDIF
-
-!
-!-- If required, compute prognostic equation for salinity
-    IF ( ocean )  THEN
-
-       CALL cpu_log( log_point(37), 'sa-equation', 'start' )
-
-!
-!--    sa-tendency terms with communication
-       sbt = tsc(2)
-       IF ( scalar_advec == 'bc-scheme' )  THEN
-
-          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--          Bott-Chlond scheme always uses Euler time step. Thus:
-             sbt = 1.0_wp
-          ENDIF
-          tend = 0.0_wp
-          CALL advec_s_bc( sa, 'sa' )
-
-       ENDIF
-
-!
-!--    sa-tendency terms with no communication
-       IF ( scalar_advec /= 'bc-scheme' )  THEN
-          tend = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( ws_scheme_sca )  THEN
-                 CALL advec_s_ws( sa, 'sa' )
-             ELSE
-                 CALL advec_s_pw( sa )
-             ENDIF
-          ELSE
-             CALL advec_s_up( sa )
-          ENDIF
-       ENDIF
-
-       CALL diffusion_s( sa, saswsb, saswst, wall_salinityflux )
-
-       CALL user_actions( 'sa-tendency' )
-
-!
-!--    Prognostic equation for salinity
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-             DO  k = nzb_s_inner(j,i)+1, nzt
-                sa_p(k,j,i) = sa(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +        &
-                                                    tsc(3) * tsa_m(k,j,i) )    &
-                                        - tsc(5) * rdf_sc(k) *                 &
-                                          ( sa(k,j,i) - sa_init(k) )
-                IF ( sa_p(k,j,i) < 0.0_wp )  sa_p(k,j,i) = 0.1_wp * sa(k,j,i)
-!
-!--             Tendencies for the next Runge-Kutta step
-                IF ( runge_step == 1 )  THEN
-                   tsa_m(k,j,i) = tend(k,j,i)
-                ELSEIF ( runge_step == 2 )  THEN
-                   tsa_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tsa_m(k,j,i)
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-       CALL cpu_log( log_point(37), 'sa-equation', 'stop' )
-
-!
-!--    Calculate density by the equation of state for seawater
-       CALL cpu_log( log_point(38), 'eqns-seawater', 'start' )
-       CALL eqn_state_seawater
-       CALL cpu_log( log_point(38), 'eqns-seawater', 'stop' )
-
-    ENDIF
-
-!
-!-- If required, compute prognostic equation for total water content / scalar
-    IF ( humidity  .OR.  passive_scalar )  THEN
-
-       CALL cpu_log( log_point(29), 'q/s-equation', 'start' )
-
-!
-!--    Scalar/q-tendency terms with communication
-       sbt = tsc(2)
-       IF ( scalar_advec == 'bc-scheme' )  THEN
-
-          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--          Bott-Chlond scheme always uses Euler time step. Thus:
-             sbt = 1.0_wp
-          ENDIF
-          tend = 0.0_wp
-          CALL advec_s_bc( q, 'q' )
-
-       ENDIF
-
-!
-!--    Scalar/q-tendency terms with no communication
-       IF ( scalar_advec /= 'bc-scheme' )  THEN
-          tend = 0.0_wp
-          IF ( timestep_scheme(1:5) == 'runge' )  THEN
-             IF ( ws_scheme_sca )  THEN
-                CALL advec_s_ws( q, 'q' )
-             ELSE
-                CALL advec_s_pw( q )
-             ENDIF
-          ELSE
-             CALL advec_s_up( q )
-          ENDIF
-       ENDIF
-
-       CALL diffusion_s( q, qsws, qswst, wall_qflux )
-
-!
-!--    Sink or source of scalar concentration due to canopy elements
-       IF ( plant_canopy ) CALL pcm_tendency( 5 )
-
-!
-!--    Large scale advection
-       IF ( large_scale_forcing )  THEN
-          CALL ls_advec( simulated_time, 'q' )
-       ENDIF
-
-!
-!--    Nudging
-       IF ( nudging )  CALL nudge( simulated_time, 'q' ) 
-
-!
-!--    If required compute influence of large-scale subsidence/ascent
-       IF ( large_scale_subsidence  .AND.                                      &
-            .NOT. use_subsidence_tendencies )  THEN
-         CALL subsidence( tend, q, q_init, 3 )
-       ENDIF
-
-       CALL user_actions( 'q-tendency' )
-
-!
-!--    Prognostic equation for total water content / scalar
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-             DO  k = nzb_s_inner(j,i)+1, nzt
-                q_p(k,j,i) = q(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +          &
-                                                  tsc(3) * tq_m(k,j,i) )       &
-                                      - tsc(5) * rdf_sc(k) *                   &
-                                        ( q(k,j,i) - q_init(k) )
-                IF ( q_p(k,j,i) < 0.0_wp )  q_p(k,j,i) = 0.1_wp * q(k,j,i)
-!
-!--             Tendencies for the next Runge-Kutta step
-                IF ( runge_step == 1 )  THEN
-                   tq_m(k,j,i) = tend(k,j,i)
-                ELSEIF ( runge_step == 2 )  THEN
-                   tq_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tq_m(k,j,i)
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-
-       CALL cpu_log( log_point(29), 'q/s-equation', 'stop' )
-
-!
-!--    If required, calculate prognostic equations for rain water content 
-!--    and rain drop concentration
-       IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
-
-          CALL cpu_log( log_point(52), 'qr-equation', 'start' )
-!
-!--       qr-tendency terms with communication
-          sbt = tsc(2)
-          IF ( scalar_advec == 'bc-scheme' )  THEN
-
-             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--             Bott-Chlond scheme always uses Euler time step. Thus:
-                sbt = 1.0_wp
-             ENDIF
-             tend = 0.0_wp
-             CALL advec_s_bc( qr, 'qr' )
-
-          ENDIF
-
-!
-!--       qr-tendency terms with no communication
-          IF ( scalar_advec /= 'bc-scheme' )  THEN
-             tend = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( ws_scheme_sca )  THEN
-                   CALL advec_s_ws( qr, 'qr' )
-                ELSE
-                   CALL advec_s_pw( qr )
-                ENDIF
-             ELSE
-                CALL advec_s_up( qr )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( qr, qrsws, qrswst, wall_qrflux )
-
-!
-!--       Prognostic equation for rain water content
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-                DO  k = nzb_s_inner(j,i)+1, nzt
-                   qr_p(k,j,i) = qr(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +     &
-                                                       tsc(3) * tqr_m(k,j,i) ) &
-                                           - tsc(5) * rdf_sc(k) * qr(k,j,i)
-                   IF ( qr_p(k,j,i) < 0.0_wp )  qr_p(k,j,i) = 0.0_wp
-!
-!--                Tendencies for the next Runge-Kutta step
-                   IF ( runge_step == 1 )  THEN
-                      tqr_m(k,j,i) = tend(k,j,i)
-                   ELSEIF ( runge_step == 2 )  THEN
-                      tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp *    &
-                                                                tqr_m(k,j,i)
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-
-          CALL cpu_log( log_point(52), 'qr-equation', 'stop' )
-          CALL cpu_log( log_point(53), 'nr-equation', 'start' )
-
-!
-!--       nr-tendency terms with communication
-          sbt = tsc(2)
-          IF ( scalar_advec == 'bc-scheme' )  THEN
-
-             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--             Bott-Chlond scheme always uses Euler time step. Thus:
-                sbt = 1.0_wp
-             ENDIF
-             tend = 0.0_wp
-             CALL advec_s_bc( nr, 'nr' )
-
-          ENDIF
-
-!
-!--       nr-tendency terms with no communication
-          IF ( scalar_advec /= 'bc-scheme' )  THEN
-             tend = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( ws_scheme_sca )  THEN
-                   CALL advec_s_ws( nr, 'nr' )
-                ELSE
-                   CALL advec_s_pw( nr )
-                ENDIF
-             ELSE
-                CALL advec_s_up( nr )
-             ENDIF
-          ENDIF
-
-          CALL diffusion_s( nr, nrsws, nrswst, wall_nrflux )
-
-!
-!--       Prognostic equation for rain drop concentration
-          DO  i = i_left, i_right
-             DO  j = j_south, j_north
-                DO  k = nzb_s_inner(j,i)+1, nzt
-                   nr_p(k,j,i) = nr(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +     &
-                                                       tsc(3) * tnr_m(k,j,i) ) &
-                                           - tsc(5) * rdf_sc(k) * nr(k,j,i)
-                   IF ( nr_p(k,j,i) < 0.0_wp )  nr_p(k,j,i) = 0.0_wp
-!
-!--                Tendencies for the next Runge-Kutta step
-                   IF ( runge_step == 1 )  THEN
-                      tnr_m(k,j,i) = tend(k,j,i)
-                   ELSEIF ( runge_step == 2 )  THEN
-                      tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp *    &
-                                                                tnr_m(k,j,i)
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDDO
-
-          CALL cpu_log( log_point(53), 'nr-equation', 'stop' )
-
-       ENDIF
-
-    ENDIF
-
-!
-!-- If required, compute prognostic equation for turbulent kinetic
-!-- energy (TKE)
-    IF ( .NOT. constant_diffusion )  THEN
-
-       CALL cpu_log( log_point(16), 'tke-equation', 'start' )
-
-       sbt = tsc(2)
-       IF ( .NOT. use_upstream_for_tke )  THEN
-          IF ( scalar_advec == 'bc-scheme' )  THEN
-
-             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--             Bott-Chlond scheme always uses Euler time step. Thus:
-                sbt = 1.0_wp
-             ENDIF
-             tend = 0.0_wp
-             CALL advec_s_bc( e, 'e' )
-
-          ENDIF
-       ENDIF
-
-!
-!--    TKE-tendency terms with no communication
-       IF ( scalar_advec /= 'bc-scheme'  .OR.  use_upstream_for_tke )  THEN
-          IF ( use_upstream_for_tke )  THEN
-             tend = 0.0_wp
-             CALL advec_s_up( e )
-          ELSE
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( ws_scheme_sca )  THEN
-                   CALL advec_s_ws_acc( e, 'e' )
-                ELSE
-                   tend = 0.0_wp    ! to be removed later??
-                   CALL advec_s_pw( e )
-                ENDIF
-             ELSE
-                tend = 0.0_wp    ! to be removed later??
-                CALL advec_s_up( e )
-             ENDIF
-          ENDIF
-       ENDIF
-
-       IF ( .NOT. humidity )  THEN
-          IF ( ocean )  THEN
-             CALL diffusion_e( prho, prho_reference )
-          ELSE
-             CALL diffusion_e_acc( pt, pt_reference )
-          ENDIF
-       ELSE
-          CALL diffusion_e( vpt, pt_reference )
-       ENDIF
-
-       CALL production_e_acc
-
-!
-!--    Additional sink term for flows through plant canopies
-       IF ( plant_canopy )  CALL pcm_tendency( 6 )
-       CALL user_actions( 'e-tendency' )
-
-!
-!--    Prognostic equation for TKE.
-!--    Eliminate negative TKE values, which can occur due to numerical
-!--    reasons in the course of the integration. In such cases the old TKE
-!--    value is reduced by 90%.
-       !$acc kernels present( e, e_p, nzb_s_inner, tend, te_m )
-       !$acc loop independent
-       DO  i = i_left, i_right
-          !$acc loop independent
-          DO  j = j_south, j_north
-             !$acc loop independent
-             DO  k = 1, nzt
-                IF ( k > nzb_s_inner(j,i) )  THEN
-                   e_p(k,j,i) = e(k,j,i) + dt_3d * ( sbt * tend(k,j,i) +          &
-                                                     tsc(3) * te_m(k,j,i) )
-                   IF ( e_p(k,j,i) < 0.0_wp )  e_p(k,j,i) = 0.1_wp * e(k,j,i)
-!
-!--                Tendencies for the next Runge-Kutta step
-                   IF ( runge_step == 1 )  THEN
-                      te_m(k,j,i) = tend(k,j,i)
-                   ELSEIF ( runge_step == 2 )  THEN
-                      te_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * te_m(k,j,i)
-                   ENDIF
-                ENDIF
-             ENDDO
-          ENDDO
-       ENDDO
-       !$acc end kernels
-
-       CALL cpu_log( log_point(16), 'tke-equation', 'stop' )
-
-    ENDIF
-
- END SUBROUTINE prognostic_equations_acc
-
-
- END MODULE prognostic_equations_mod
Index: /palm/trunk/SOURCE/user_actions.f90
===================================================================
--- /palm/trunk/SOURCE/user_actions.f90	(revision 1873)
+++ /palm/trunk/SOURCE/user_actions.f90	(revision 1873)
@@ -0,0 +1,244 @@
+!> @file user_actions.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+!
+! 
+! 1822 2016-04-07 07:49:42Z hoffmann
+! qr/nr-tendency removed.
+!
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+! 
+! 1320 2014-03-20 08:40:49Z raasch
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements 
+!
+! 1318 2014-03-17 13:35:16Z raasch
+! module interfaces removed
+!
+! 1053 2012-11-13 17:11:03Z hoffmann
+! +qr-tendency, nr-tendency
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 211 2008-11-11 04:46:24Z raasch
+! Former file user_interface.f90 split into one file per subroutine
+!
+! Description:
+! ------------
+!> Execution of user-defined actions before or after single timesteps
+!------------------------------------------------------------------------------!
+ MODULE user_actions_mod
+ 
+
+    PRIVATE
+    PUBLIC user_actions
+
+    INTERFACE user_actions
+       MODULE PROCEDURE user_actions
+       MODULE PROCEDURE user_actions_ij
+    END INTERFACE user_actions
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE user_actions( location )
+
+       USE control_parameters
+
+       USE cpulog
+
+       USE indices
+
+       USE kinds
+
+       USE pegrid
+
+       USE user
+
+       USE arrays_3d
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  location !< 
+
+       INTEGER(iwp) ::  i !< 
+       INTEGER(iwp) ::  j !< 
+       INTEGER(iwp) ::  k !< 
+
+       CALL cpu_log( log_point(24), 'user_actions', 'start' )
+
+!
+!--    Here the user-defined actions follow
+!--    No calls for single grid points are allowed at locations before and
+!--    after the timestep, since these calls are not within an i,j-loop
+       SELECT CASE ( location )
+
+          CASE ( 'before_timestep' )
+!
+!--          Enter actions to be done before every timestep here
+
+
+          CASE ( 'after_integration' )
+!
+!--          Enter actions to be done after every time integration (before
+!--          data output)
+!--          Sample for user-defined output:
+!             DO  i = nxlg, nxrg
+!                DO  j = nysg, nyng
+!                   DO  k = nzb, nzt
+!                      u2(k,j,i) = u(k,j,i)**2
+!                   ENDDO
+!                ENDDO
+!             ENDDO
+!             DO  i = nxlg, nxr
+!                DO  j = nysg, nyn
+!                   DO  k = nzb, nzt+1
+!                      ustvst(k,j,i) =  &
+!                         ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,0) ) * &
+!                         ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,0) )
+!                   ENDDO
+!                ENDDO
+!             ENDDO
+
+
+          CASE ( 'after_timestep' )
+!
+!--          Enter actions to be done after every timestep here
+
+
+          CASE ( 'u-tendency' )
+!
+!--          Enter actions to be done in the u-tendency term here
+
+
+          CASE ( 'v-tendency' )
+
+
+          CASE ( 'w-tendency' )
+
+
+          CASE ( 'pt-tendency' )
+
+
+          CASE ( 'sa-tendency' )
+
+
+          CASE ( 'e-tendency' )
+
+
+          CASE ( 'q-tendency' )
+
+
+          CASE DEFAULT
+             message_string = 'unknown location "' // location // '"'
+             CALL message( 'user_actions', 'UI0001', 1, 2, 0, 6, 0 )
+
+       END SELECT
+
+       CALL cpu_log( log_point(24), 'user_actions', 'stop' )
+
+    END SUBROUTINE user_actions
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE user_actions_ij( i, j, location )
+
+       USE control_parameters
+       USE kinds
+       USE pegrid
+       USE user
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  location
+
+       INTEGER(iwp) ::  i
+       INTEGER(iwp) ::  idum
+       INTEGER(iwp) ::  j
+
+!
+!--    Here the user-defined actions follow
+       SELECT CASE ( location )
+
+          CASE ( 'u-tendency' )
+!
+!--          Enter actions to be done in the u-tendency term here
+
+
+          CASE ( 'v-tendency' )
+
+
+          CASE ( 'w-tendency' )
+
+
+          CASE ( 'pt-tendency' )
+
+
+          CASE ( 'sa-tendency' )
+
+
+          CASE ( 'e-tendency' )
+
+
+          CASE ( 'q-tendency' )
+
+
+          CASE ( 'before_timestep', 'after_integration', 'after_timestep' )
+             message_string = 'location "' // location // '" is not ' // &
+                             'allowed to be called with parameters "i" and "j"'
+             CALL message( 'user_actions', 'UI0002', 1, 2, 0, 6, 0 )
+
+
+          CASE DEFAULT
+             message_string = 'unknown location "' // location // '"'
+             CALL message( 'user_actions', 'UI0001', 1, 2, 0, 6, 0 )
+             
+
+       END SELECT
+
+    END SUBROUTINE user_actions_ij
+
+ END MODULE user_actions_mod
Index: lm/trunk/SOURCE/user_actions_mod.f90
===================================================================
--- /palm/trunk/SOURCE/user_actions_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,243 +1,0 @@
-!> @file user_actions_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! ------------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-!
-! 
-! 1822 2016-04-07 07:49:42Z hoffmann
-! qr/nr-tendency removed.
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-! 
-! 1320 2014-03-20 08:40:49Z raasch
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements 
-!
-! 1318 2014-03-17 13:35:16Z raasch
-! module interfaces removed
-!
-! 1053 2012-11-13 17:11:03Z hoffmann
-! +qr-tendency, nr-tendency
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 211 2008-11-11 04:46:24Z raasch
-! Former file user_interface.f90 split into one file per subroutine
-!
-! Description:
-! ------------
-!> Execution of user-defined actions before or after single timesteps
-!------------------------------------------------------------------------------!
- MODULE user_actions_mod
- 
-
-    PRIVATE
-    PUBLIC user_actions
-
-    INTERFACE user_actions
-       MODULE PROCEDURE user_actions
-       MODULE PROCEDURE user_actions_ij
-    END INTERFACE user_actions
-
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE user_actions( location )
-
-       USE control_parameters
-
-       USE cpulog
-
-       USE indices
-
-       USE kinds
-
-       USE pegrid
-
-       USE user
-
-       USE arrays_3d
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  location !< 
-
-       INTEGER(iwp) ::  i !< 
-       INTEGER(iwp) ::  j !< 
-       INTEGER(iwp) ::  k !< 
-
-       CALL cpu_log( log_point(24), 'user_actions', 'start' )
-
-!
-!--    Here the user-defined actions follow
-!--    No calls for single grid points are allowed at locations before and
-!--    after the timestep, since these calls are not within an i,j-loop
-       SELECT CASE ( location )
-
-          CASE ( 'before_timestep' )
-!
-!--          Enter actions to be done before every timestep here
-
-
-          CASE ( 'after_integration' )
-!
-!--          Enter actions to be done after every time integration (before
-!--          data output)
-!--          Sample for user-defined output:
-!             DO  i = nxlg, nxrg
-!                DO  j = nysg, nyng
-!                   DO  k = nzb, nzt
-!                      u2(k,j,i) = u(k,j,i)**2
-!                   ENDDO
-!                ENDDO
-!             ENDDO
-!             DO  i = nxlg, nxr
-!                DO  j = nysg, nyn
-!                   DO  k = nzb, nzt+1
-!                      ustvst(k,j,i) =  &
-!                         ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,0) ) * &
-!                         ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,0) )
-!                   ENDDO
-!                ENDDO
-!             ENDDO
-
-
-          CASE ( 'after_timestep' )
-!
-!--          Enter actions to be done after every timestep here
-
-
-          CASE ( 'u-tendency' )
-!
-!--          Enter actions to be done in the u-tendency term here
-
-
-          CASE ( 'v-tendency' )
-
-
-          CASE ( 'w-tendency' )
-
-
-          CASE ( 'pt-tendency' )
-
-
-          CASE ( 'sa-tendency' )
-
-
-          CASE ( 'e-tendency' )
-
-
-          CASE ( 'q-tendency' )
-
-
-          CASE DEFAULT
-             message_string = 'unknown location "' // location // '"'
-             CALL message( 'user_actions', 'UI0001', 1, 2, 0, 6, 0 )
-
-       END SELECT
-
-       CALL cpu_log( log_point(24), 'user_actions', 'stop' )
-
-    END SUBROUTINE user_actions
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE user_actions_ij( i, j, location )
-
-       USE control_parameters
-       USE kinds
-       USE pegrid
-       USE user
-
-       IMPLICIT NONE
-
-       CHARACTER (LEN=*) ::  location
-
-       INTEGER(iwp) ::  i
-       INTEGER(iwp) ::  idum
-       INTEGER(iwp) ::  j
-
-!
-!--    Here the user-defined actions follow
-       SELECT CASE ( location )
-
-          CASE ( 'u-tendency' )
-!
-!--          Enter actions to be done in the u-tendency term here
-
-
-          CASE ( 'v-tendency' )
-
-
-          CASE ( 'w-tendency' )
-
-
-          CASE ( 'pt-tendency' )
-
-
-          CASE ( 'sa-tendency' )
-
-
-          CASE ( 'e-tendency' )
-
-
-          CASE ( 'q-tendency' )
-
-
-          CASE ( 'before_timestep', 'after_integration', 'after_timestep' )
-             message_string = 'location "' // location // '" is not ' // &
-                             'allowed to be called with parameters "i" and "j"'
-             CALL message( 'user_actions', 'UI0002', 1, 2, 0, 6, 0 )
-
-
-          CASE DEFAULT
-             message_string = 'unknown location "' // location // '"'
-             CALL message( 'user_actions', 'UI0001', 1, 2, 0, 6, 0 )
-             
-
-       END SELECT
-
-    END SUBROUTINE user_actions_ij
-
- END MODULE user_actions_mod
Index: /palm/trunk/SOURCE/user_module.f90
===================================================================
--- /palm/trunk/SOURCE/user_module.f90	(revision 1873)
+++ /palm/trunk/SOURCE/user_module.f90	(revision 1873)
@@ -0,0 +1,77 @@
+!> @file user_module.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! kind-parameters added to all INTEGER and REAL declaration statements, 
+! kinds are defined in new module kinds, 
+! old module precision_kind is removed,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements 
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! Revision 1.1  1998/03/24 15:29:04  raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+!> Declaration of user-defined variables. This module may only be used
+!> in the user-defined routines (contained in user_interface.f90).
+!------------------------------------------------------------------------------!
+ MODULE user
+ 
+
+    USE kinds
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  dots_num_palm   !< 
+    INTEGER(iwp) ::  user_idummy     !< 
+    
+    LOGICAL ::  user_defined_namelist_found = .FALSE.   !< 
+    
+    REAL(wp) ::  user_rdummy   !< 
+
+!
+!-- Sample for user-defined output
+!    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u2       !< user defined array
+!    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u2_av    !< user defined array
+!    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ustvst   !< user defined array
+
+    SAVE
+
+ END MODULE user
Index: lm/trunk/SOURCE/user_module_mod.f90
===================================================================
--- /palm/trunk/SOURCE/user_module_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,76 +1,0 @@
-!> @file user_module_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! kind-parameters added to all INTEGER and REAL declaration statements, 
-! kinds are defined in new module kinds, 
-! old module precision_kind is removed,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements 
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! Revision 1.1  1998/03/24 15:29:04  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Declaration of user-defined variables. This module may only be used
-!> in the user-defined routines (contained in user_interface.f90).
-!------------------------------------------------------------------------------!
- MODULE user
- 
-
-    USE kinds
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  dots_num_palm   !< 
-    INTEGER(iwp) ::  user_idummy     !< 
-    
-    LOGICAL ::  user_defined_namelist_found = .FALSE.   !< 
-    
-    REAL(wp) ::  user_rdummy   !< 
-
-!
-!-- Sample for user-defined output
-!    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u2       !< user defined array
-!    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u2_av    !< user defined array
-!    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ustvst   !< user defined array
-
-    SAVE
-
- END MODULE user
Index: /palm/trunk/SOURCE/wall_fluxes.f90
===================================================================
--- /palm/trunk/SOURCE/wall_fluxes.f90	(revision 1873)
+++ /palm/trunk/SOURCE/wall_fluxes.f90	(revision 1873)
@@ -0,0 +1,1109 @@
+!> @file wall_fluxes.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2016 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Module renamed (removed _mod)
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 1850 2016-04-08 13:29:27Z maronga
+! Module renamed
+! 
+! 
+! 1691 2015-10-26 16:17:44Z maronga
+! Renamed rif_min and rif_max with zeta_min and zeta_max, respectively.
+! 
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1374 2014-04-25 12:55:07Z raasch
+! pt removed from acc-present-list
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements, 
+! kinds are defined in new module kinds, 
+! old module precision_kind is removed,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements 
+!
+! 1257 2013-11-08 15:18:40Z raasch
+! openacc loop and loop vector clauses removed
+!
+! 1153 2013-05-10 14:33:08Z raasch
+! code adjustments of accelerator version required by PGI 12.3 / CUDA 5.0
+!
+! 1128 2013-04-12 06:19:32Z raasch
+! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
+! j_north
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 1015 2012-09-27 09:23:24Z raasch
+! accelerator version (*_acc) added
+!
+! Initial version (2007/03/07)
+!
+! Description:
+! ------------
+!> Calculates momentum fluxes at vertical walls assuming Monin-Obukhov
+!> similarity.
+!> Indices: usvs a=1, vsus b=1, wsvs c1=1, wsus c2=1 (other=0).
+!> The all-gridpoint version of wall_fluxes_e is not used so far, because
+!> it gives slightly different results from the ij-version for some unknown
+!> reason.
+!>
+!> @todo Rename rif to zeta throughout the routine
+!------------------------------------------------------------------------------!
+ MODULE wall_fluxes_mod
+ 
+    PRIVATE
+    PUBLIC wall_fluxes, wall_fluxes_acc, wall_fluxes_e, wall_fluxes_e_acc
+    
+    INTERFACE wall_fluxes
+       MODULE PROCEDURE wall_fluxes
+       MODULE PROCEDURE wall_fluxes_ij
+    END INTERFACE wall_fluxes
+    
+    INTERFACE wall_fluxes_acc
+       MODULE PROCEDURE wall_fluxes_acc
+    END INTERFACE wall_fluxes_acc
+
+    INTERFACE wall_fluxes_e
+       MODULE PROCEDURE wall_fluxes_e
+       MODULE PROCEDURE wall_fluxes_e_ij
+    END INTERFACE wall_fluxes_e
+ 
+    INTERFACE wall_fluxes_e_acc
+       MODULE PROCEDURE wall_fluxes_e_acc
+    END INTERFACE wall_fluxes_e_acc
+
+ CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!------------------------------------------------------------------------------!
+    SUBROUTINE wall_fluxes( wall_flux, a, b, c1, c2, nzb_uvw_inner,            &
+                            nzb_uvw_outer, wall )
+
+       USE arrays_3d,                                                          &
+           ONLY:  rif_wall, u, v, w, z0, pt
+       
+       USE control_parameters,                                                 &
+           ONLY:  g, kappa, zeta_max, zeta_min
+       
+       USE grid_variables,                                                     &
+           ONLY:  dx, dy
+       
+       USE indices,                                                            &
+           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
+       
+       USE kinds
+       
+       USE statistics,                                                         &
+           ONLY:  hom
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i            !< 
+       INTEGER(iwp) ::  j            !< 
+       INTEGER(iwp) ::  k            !< 
+       INTEGER(iwp) ::  wall_index   !< 
+
+       INTEGER(iwp),                                                           &
+          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
+             nzb_uvw_inner   !< 
+       INTEGER(iwp),                                                           &
+          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
+             nzb_uvw_outer   !< 
+       
+       REAL(wp) ::  a           !< 
+       REAL(wp) ::  b           !< 
+       REAL(wp) ::  c1          !< 
+       REAL(wp) ::  c2          !< 
+       REAL(wp) ::  h1          !< 
+       REAL(wp) ::  h2          !< 
+       REAL(wp) ::  zp          !< 
+       REAL(wp) ::  pts         !< 
+       REAL(wp) ::  pt_i        !< 
+       REAL(wp) ::  rifs        !< 
+       REAL(wp) ::  u_i         !< 
+       REAL(wp) ::  v_i         !< 
+       REAL(wp) ::  us_wall     !< 
+       REAL(wp) ::  vel_total   !< 
+       REAL(wp) ::  ws          !< 
+       REAL(wp) ::  wspts       !< 
+
+       REAL(wp),                                                               &
+          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
+             wall   !< 
+       
+       REAL(wp),                                                               &
+          DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::                              &
+             wall_flux   !< 
+
+
+       zp         = 0.5_wp * ( (a+c1) * dy + (b+c2) * dx )
+       wall_flux  = 0.0_wp
+       wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+
+             IF ( wall(j,i) /= 0.0_wp )  THEN
+!
+!--             All subsequent variables are computed for the respective
+!--             location where the respective flux is defined.
+                DO  k = nzb_uvw_inner(j,i)+1, nzb_uvw_outer(j,i)
+
+!
+!--                (1) Compute rifs, u_i, v_i, ws, pt' and w'pt'
+                   rifs  = rif_wall(k,j,i,wall_index)
+
+                   u_i   = a * u(k,j,i) + c1 * 0.25_wp *                       &
+                           ( u(k+1,j,i+1) + u(k+1,j,i) + u(k,j,i+1) + u(k,j,i) )
+
+                   v_i   = b * v(k,j,i) + c2 * 0.25_wp *                       &
+                           ( v(k+1,j+1,i) + v(k+1,j,i) + v(k,j+1,i) + v(k,j,i) )
+
+                   ws    = ( c1 + c2 ) * w(k,j,i) + 0.25_wp * (                &
+                     a * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) ) &
+                   + b * ( w(k-1,j-1,i) + w(k-1,j,i) + w(k,j-1,i) + w(k,j,i) ) &
+                                                              )
+                   pt_i  = 0.5_wp * ( pt(k,j,i) + a *  pt(k,j,i-1) +           &
+                                   b * pt(k,j-1,i) + ( c1 + c2 ) * pt(k+1,j,i) )
+
+                   pts   = pt_i - hom(k,1,4,0)
+                   wspts = ws * pts
+
+!
+!--                (2) Compute wall-parallel absolute velocity vel_total
+                   vel_total = SQRT( ws**2 + (a+c1) * u_i**2 + (b+c2) * v_i**2 )
+
+!
+!--                (3) Compute wall friction velocity us_wall
+                   IF ( rifs >= 0.0_wp )  THEN
+
+!
+!--                   Stable stratification (and neutral)
+                      us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) +    &
+                                         5.0_wp * rifs * ( zp - z0(j,i) ) / zp &
+                                                    )
+                   ELSE
+
+!
+!--                   Unstable stratification
+                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
+                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
+
+                      us_wall = kappa * vel_total / (                          &
+                           LOG( zp / z0(j,i) ) -                               &
+                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
+                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
+                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
+                                                    )
+                   ENDIF
+
+!
+!--                (4) Compute zp/L (corresponds to neutral Richardson flux
+!--                    number rifs)
+                   rifs = -1.0_wp * zp * kappa * g * wspts /                   &
+                          ( pt_i * ( us_wall**3 + 1E-30 ) )
+
+!
+!--                Limit the value range of the Richardson numbers.
+!--                This is necessary for very small velocities (u,w --> 0),
+!--                because the absolute value of rif can then become very
+!--                large, which in consequence would result in very large
+!--                shear stresses and very small momentum fluxes (both are
+!--                generally unrealistic).
+                   IF ( rifs < zeta_min )  rifs = zeta_min
+                   IF ( rifs > zeta_max )  rifs = zeta_max
+
+!
+!--                (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
+                   IF ( rifs >= 0.0_wp )  THEN
+
+!
+!--                   Stable stratification (and neutral)
+                      wall_flux(k,j,i) = kappa *                               &
+                              ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / &
+                              (  LOG( zp / z0(j,i) ) +                         &
+                                 5.0_wp * rifs * ( zp - z0(j,i) ) / zp         &
+                              )
+                   ELSE
+
+!
+!--                   Unstable stratification
+                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
+                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
+
+                      wall_flux(k,j,i) = kappa *                               &
+                           ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / (  &
+                           LOG( zp / z0(j,i) ) -                               &
+                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
+                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
+                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
+                                                                            )
+                   ENDIF
+                   wall_flux(k,j,i) = -wall_flux(k,j,i) * us_wall
+
+!
+!--                store rifs for next time step
+                   rif_wall(k,j,i,wall_index) = rifs
+
+                ENDDO
+
+             ENDIF
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE wall_fluxes
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE wall_fluxes_acc( wall_flux, a, b, c1, c2, nzb_uvw_inner,        &
+                                nzb_uvw_outer, wall )
+
+       USE arrays_3d,                                                          &
+           ONLY:  rif_wall, pt, u, v, w, z0
+       
+       USE control_parameters,                                                 &
+           ONLY:  g, kappa, zeta_max, zeta_min
+       
+       USE grid_variables,                                                     &
+           ONLY:  dx, dy
+       
+       USE indices,                                                            &
+           ONLY:  i_left, i_right, j_north, j_south, nxl, nxlg, nxr, nxrg,     &
+                  nyn, nyng, nys, nysg, nzb, nzt
+       
+       USE kinds
+       
+       USE statistics,                                                         &
+           ONLY:  hom
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i            !< 
+       INTEGER(iwp) ::  j            !< 
+       INTEGER(iwp) ::  k            !< 
+       INTEGER(iwp) ::  max_outer    !< 
+       INTEGER(iwp) ::  min_inner    !< 
+       INTEGER(iwp) ::  wall_index   !< 
+
+       INTEGER(iwp),                                                           &
+          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
+             nzb_uvw_inner   !< 
+       INTEGER(iwp),                                                           &
+          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
+             nzb_uvw_outer   !< 
+       
+       REAL(wp) ::  a           !< 
+       REAL(wp) ::  b           !< 
+       REAL(wp) ::  c1          !< 
+       REAL(wp) ::  c2          !< 
+       REAL(wp) ::  h1          !< 
+       REAL(wp) ::  h2          !< 
+       REAL(wp) ::  zp          !< 
+       REAL(wp) ::  pts         !< 
+       REAL(wp) ::  pt_i        !< 
+       REAL(wp) ::  rifs        !< 
+       REAL(wp) ::  u_i         !< 
+       REAL(wp) ::  v_i         !< 
+       REAL(wp) ::  us_wall     !< 
+       REAL(wp) ::  vel_total   !< 
+       REAL(wp) ::  ws          !< 
+       REAL(wp) ::  wspts       !< 
+
+       REAL(wp),                                                               &
+          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
+             wall   !< 
+       
+       REAL(wp),                                                               &
+          DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::                              &
+             wall_flux   !< 
+
+
+       zp         = 0.5_wp * ( (a+c1) * dy + (b+c2) * dx )
+       wall_flux  = 0.0_wp
+       wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
+
+       min_inner = MINVAL( nzb_uvw_inner(nys:nyn,nxl:nxr) ) + 1
+       max_outer = MINVAL( nzb_uvw_outer(nys:nyn,nxl:nxr) )
+
+       !$acc kernels present( hom, nzb_uvw_inner, nzb_uvw_outer, pt, rif_wall ) &
+       !$acc         present( u, v, w, wall, wall_flux, z0 )
+       !$acc loop independent
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+
+             IF ( wall(j,i) /= 0.0_wp )  THEN
+!
+!--             All subsequent variables are computed for the respective
+!--             location where the respective flux is defined.
+                !$acc loop independent
+                DO  k = nzb_uvw_inner(j,i)+1, nzb_uvw_outer(j,i)
+
+!
+!--                (1) Compute rifs, u_i, v_i, ws, pt' and w'pt'
+                   rifs  = rif_wall(k,j,i,wall_index)
+
+                   u_i   = a * u(k,j,i) + c1 * 0.25_wp *                       &
+                           ( u(k+1,j,i+1) + u(k+1,j,i) + u(k,j,i+1) + u(k,j,i) )
+
+                   v_i   = b * v(k,j,i) + c2 * 0.25_wp *                       &
+                           ( v(k+1,j+1,i) + v(k+1,j,i) + v(k,j+1,i) + v(k,j,i) )
+
+                   ws    = ( c1 + c2 ) * w(k,j,i) + 0.25_wp * (                &
+                     a * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) ) &
+                   + b * ( w(k-1,j-1,i) + w(k-1,j,i) + w(k,j-1,i) + w(k,j,i) ) &
+                                                              )
+                   pt_i  = 0.5_wp * ( pt(k,j,i) + a *  pt(k,j,i-1) +           &
+                                   b * pt(k,j-1,i) + ( c1 + c2 ) * pt(k+1,j,i) )
+
+                   pts   = pt_i - hom(k,1,4,0)
+                   wspts = ws * pts
+
+!
+!--                (2) Compute wall-parallel absolute velocity vel_total
+                   vel_total = SQRT( ws**2 + (a+c1) * u_i**2 + (b+c2) * v_i**2 )
+
+!
+!--                (3) Compute wall friction velocity us_wall
+                   IF ( rifs >= 0.0_wp )  THEN
+
+!
+!--                   Stable stratification (and neutral)
+                      us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) +    &
+                                         5.0_wp * rifs * ( zp - z0(j,i) ) / zp &
+                                                    )
+                   ELSE
+
+!
+!--                   Unstable stratification
+                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
+                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
+
+                      us_wall = kappa * vel_total / (                          &
+                           LOG( zp / z0(j,i) ) -                               &
+                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
+                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
+                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
+                                                    )
+                   ENDIF
+
+!
+!--                (4) Compute zp/L (corresponds to neutral Richardson flux
+!--                    number rifs)
+                   rifs = -1.0_wp * zp * kappa * g * wspts /                   &
+                          ( pt_i * ( us_wall**3 + 1E-30 ) )
+
+!
+!--                Limit the value range of the Richardson numbers.
+!--                This is necessary for very small velocities (u,w --> 0),
+!--                because the absolute value of rif can then become very
+!--                large, which in consequence would result in very large
+!--                shear stresses and very small momentum fluxes (both are
+!--                generally unrealistic).
+                   IF ( rifs < zeta_min )  rifs = zeta_min
+                   IF ( rifs > zeta_max )  rifs = zeta_max
+
+!
+!--                (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
+                   IF ( rifs >= 0.0_wp )  THEN
+
+!
+!--                   Stable stratification (and neutral)
+                      wall_flux(k,j,i) = kappa *                               &
+                              ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / &
+                              (  LOG( zp / z0(j,i) ) +                         &
+                                 5.0_wp * rifs * ( zp - z0(j,i) ) / zp         &
+                              )
+                   ELSE
+
+!
+!--                   Unstable stratification
+                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
+                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
+
+                      wall_flux(k,j,i) = kappa *                               &
+                           ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / (  &
+                           LOG( zp / z0(j,i) ) -                               &
+                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
+                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
+                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
+                                                                            )
+                   ENDIF
+                   wall_flux(k,j,i) = -wall_flux(k,j,i) * us_wall
+
+!
+!--                store rifs for next time step
+                   rif_wall(k,j,i,wall_index) = rifs
+
+                ENDDO
+
+             ENDIF
+
+          ENDDO
+       ENDDO
+       !$acc end kernels
+
+    END SUBROUTINE wall_fluxes_acc
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE wall_fluxes_ij( i, j, nzb_w, nzt_w, wall_flux, a, b, c1, c2 )
+
+       USE arrays_3d,                                                          &
+           ONLY:  rif_wall, pt, u, v, w, z0
+       
+       USE control_parameters,                                                 &
+           ONLY:  g, kappa, zeta_max, zeta_min
+       
+       USE grid_variables,                                                     &
+           ONLY:  dx, dy
+       
+       USE indices,                                                            &
+           ONLY:  nzb, nzt
+       
+       USE kinds
+       
+       USE statistics,                                                         &
+           ONLY:  hom
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i            !< 
+       INTEGER(iwp) ::  j            !< 
+       INTEGER(iwp) ::  k            !< 
+       INTEGER(iwp) ::  nzb_w        !< 
+       INTEGER(iwp) ::  nzt_w        !< 
+       INTEGER(iwp) ::  wall_index   !< 
+       
+       REAL(wp) ::  a           !< 
+       REAL(wp) ::  b           !< 
+       REAL(wp) ::  c1          !< 
+       REAL(wp) ::  c2          !< 
+       REAL(wp) ::  h1          !< 
+       REAL(wp) ::  h2          !< 
+       REAL(wp) ::  zp          !< 
+       REAL(wp) ::  pts         !< 
+       REAL(wp) ::  pt_i        !< 
+       REAL(wp) ::  rifs        !< 
+       REAL(wp) ::  u_i         !< 
+       REAL(wp) ::  v_i         !< 
+       REAL(wp) ::  us_wall     !< 
+       REAL(wp) ::  vel_total   !< 
+       REAL(wp) ::  ws          !< 
+       REAL(wp) ::  wspts       !< 
+
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  wall_flux   !< 
+
+
+       zp         = 0.5_wp * ( (a+c1) * dy + (b+c2) * dx )
+       wall_flux  = 0.0_wp
+       wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
+
+!
+!--    All subsequent variables are computed for the respective location where 
+!--    the respective flux is defined.
+       DO  k = nzb_w, nzt_w
+
+!
+!--       (1) Compute rifs, u_i, v_i, ws, pt' and w'pt'
+          rifs  = rif_wall(k,j,i,wall_index)
+
+          u_i   = a * u(k,j,i) + c1 * 0.25_wp *                                &
+                  ( u(k+1,j,i+1) + u(k+1,j,i) + u(k,j,i+1) + u(k,j,i) )
+
+          v_i   = b * v(k,j,i) + c2 * 0.25_wp *                                &
+                  ( v(k+1,j+1,i) + v(k+1,j,i) + v(k,j+1,i) + v(k,j,i) )
+
+          ws    = ( c1 + c2 ) * w(k,j,i) + 0.25_wp * (                         &
+                     a * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) ) &
+                   + b * ( w(k-1,j-1,i) + w(k-1,j,i) + w(k,j-1,i) + w(k,j,i) ) &
+                                                     )
+          pt_i  = 0.5_wp * ( pt(k,j,i) + a *  pt(k,j,i-1) + b * pt(k,j-1,i)    &
+                          + ( c1 + c2 ) * pt(k+1,j,i) )
+
+          pts   = pt_i - hom(k,1,4,0)
+          wspts = ws * pts
+
+!
+!--       (2) Compute wall-parallel absolute velocity vel_total
+          vel_total = SQRT( ws**2 + ( a+c1 ) * u_i**2 + ( b+c2 ) * v_i**2 )
+
+!
+!--       (3) Compute wall friction velocity us_wall
+          IF ( rifs >= 0.0_wp )  THEN
+
+!
+!--          Stable stratification (and neutral)
+             us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) +             &
+                                         5.0_wp * rifs * ( zp - z0(j,i) ) / zp &
+                                           )
+          ELSE
+
+!
+!--          Unstable stratification
+             h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
+             h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
+
+             us_wall = kappa * vel_total / (                                   &
+                  LOG( zp / z0(j,i) ) -                                        &
+                  LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (             &
+                       ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +         &
+                       2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )                    &
+                                           )
+          ENDIF
+
+!
+!--       (4) Compute zp/L (corresponds to neutral Richardson flux number 
+!--           rifs)
+          rifs = -1.0_wp * zp * kappa * g * wspts /                            &
+                  ( pt_i * (us_wall**3 + 1E-30) )
+
+!
+!--       Limit the value range of the Richardson numbers.
+!--       This is necessary for very small velocities (u,w --> 0), because
+!--       the absolute value of rif can then become very large, which in
+!--       consequence would result in very large shear stresses and very
+!--       small momentum fluxes (both are generally unrealistic).
+          IF ( rifs < zeta_min )  rifs = zeta_min
+          IF ( rifs > zeta_max )  rifs = zeta_max
+
+!
+!--       (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
+          IF ( rifs >= 0.0_wp )  THEN
+
+!
+!--          Stable stratification (and neutral)
+             wall_flux(k) = kappa *                                            &
+                            ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) /   &
+                            (  LOG( zp / z0(j,i) ) +                           &
+                               5.0_wp * rifs * ( zp - z0(j,i) ) / zp           &
+                            )
+          ELSE
+
+!
+!--          Unstable stratification
+             h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
+             h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
+
+             wall_flux(k) = kappa *                                            &
+                  ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / (           &
+                  LOG( zp / z0(j,i) ) -                                        &
+                  LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (             &
+                       ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +         &
+                       2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )                    &
+                                                                   )
+          ENDIF
+          wall_flux(k) = -wall_flux(k) * us_wall
+
+!
+!--       store rifs for next time step
+          rif_wall(k,j,i,wall_index) = rifs
+
+       ENDDO
+
+    END SUBROUTINE wall_fluxes_ij
+
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points
+!> Calculates momentum fluxes at vertical walls for routine production_e
+!> assuming Monin-Obukhov similarity.
+!> Indices: usvs a=1, vsus b=1, wsvs c1=1, wsus c2=1 (other=0).
+!------------------------------------------------------------------------------!
+
+    SUBROUTINE wall_fluxes_e( wall_flux, a, b, c1, c2, wall )
+
+
+       USE arrays_3d,                                                          &
+           ONLY:  rif_wall, u, v, w, z0
+       
+       USE control_parameters,                                                 &
+           ONLY:  kappa
+       
+       USE grid_variables,                                                     &
+           ONLY:  dx, dy
+       
+       USE indices,                                                            &
+           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb,             &
+                  nzb_diff_s_inner, nzb_diff_s_outer, nzt
+       
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i            !< 
+       INTEGER(iwp) ::  j            !< 
+       INTEGER(iwp) ::  k            !< 
+       INTEGER(iwp) ::  kk           !< 
+       INTEGER(iwp) ::  wall_index   !< 
+       
+       REAL(wp) ::  a           !< 
+       REAL(wp) ::  b           !< 
+       REAL(wp) ::  c1          !< 
+       REAL(wp) ::  c2          !< 
+       REAL(wp) ::  h1          !< 
+       REAL(wp) ::  h2          !< 
+       REAL(wp) ::  u_i         !< 
+       REAL(wp) ::  v_i         !< 
+       REAL(wp) ::  us_wall     !< 
+       REAL(wp) ::  vel_total   !< 
+       REAL(wp) ::  vel_zp      !< 
+       REAL(wp) ::  ws          !< 
+       REAL(wp) ::  zp          !< 
+       REAL(wp) ::  rifs        !< 
+
+       REAL(wp),                                                               &
+          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
+             wall   !< 
+       
+       REAL(wp),                                                               &
+          DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::                              &
+             wall_flux   !< 
+
+
+       zp         = 0.5_wp * ( (a+c1) * dy + (b+c2) * dx )
+       wall_flux  = 0.0_wp
+       wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+
+             IF ( wall(j,i) /= 0.0_wp )  THEN
+!
+!--             All subsequent variables are computed for scalar locations.
+                DO  k = nzb_diff_s_inner(j,i)-1, nzb_diff_s_outer(j,i)-2
+!
+!--                (1) Compute rifs, u_i, v_i, and ws
+                   IF ( k == nzb_diff_s_inner(j,i)-1 )  THEN
+                      kk = nzb_diff_s_inner(j,i)-1
+                   ELSE
+                      kk = k-1
+                   ENDIF
+                   rifs  = 0.5_wp * (      rif_wall(k,j,i,wall_index) +        &
+                                      a  * rif_wall(k,j,i+1,1)        +        &
+                                      b  * rif_wall(k,j+1,i,2)        +        &
+                                      c1 * rif_wall(kk,j,i,3)         +        &
+                                      c2 * rif_wall(kk,j,i,4)                  &
+                                    )
+
+                   u_i   = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
+                   v_i   = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
+                   ws    = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
+!
+!--                (2) Compute wall-parallel absolute velocity vel_total and
+!--                interpolate appropriate velocity component vel_zp.
+                   vel_total = SQRT( ws**2 + (a+c1) * u_i**2 + (b+c2) * v_i**2 )
+                   vel_zp    = 0.5_wp * ( a * u_i + b * v_i + (c1+c2) * ws )
+!
+!--                (3) Compute wall friction velocity us_wall
+                   IF ( rifs >= 0.0_wp )  THEN
+
+!
+!--                   Stable stratification (and neutral)
+                      us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) +    &
+                                         5.0_wp * rifs * ( zp - z0(j,i) ) / zp &
+                                                    )
+                   ELSE
+
+!
+!--                   Unstable stratification
+                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
+                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
+
+                      us_wall = kappa * vel_total / (                          &
+                           LOG( zp / z0(j,i) ) -                               &
+                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
+                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
+                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
+                                                    )
+                   ENDIF
+
+!
+!--                Skip step (4) of wall_fluxes, because here rifs is already
+!--                available from (1)
+!
+!--                (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
+
+                   IF ( rifs >= 0.0_wp )  THEN
+
+!
+!--                   Stable stratification (and neutral)
+                      wall_flux(k,j,i) = kappa * vel_zp / ( LOG( zp/z0(j,i) ) +&
+                                         5.0_wp * rifs * ( zp-z0(j,i) ) / zp )
+                   ELSE
+
+!
+!--                   Unstable stratification
+                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
+                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
+
+                      wall_flux(k,j,i) = kappa * vel_zp / (                    &
+                           LOG( zp / z0(j,i) ) -                               &
+                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
+                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
+                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
+                                                          )
+                   ENDIF
+                   wall_flux(k,j,i) = - wall_flux(k,j,i) * us_wall
+
+                ENDDO
+
+             ENDIF
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE wall_fluxes_e
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for all grid points - accelerator version
+!> Calculates momentum fluxes at vertical walls for routine production_e
+!> assuming Monin-Obukhov similarity.
+!> Indices: usvs a=1, vsus b=1, wsvs c1=1, wsus c2=1 (other=0).
+!------------------------------------------------------------------------------!
+    SUBROUTINE wall_fluxes_e_acc( wall_flux, a, b, c1, c2, wall )
+
+
+       USE arrays_3d,                                                          &
+           ONLY:  rif_wall, u, v, w, z0
+       
+       USE control_parameters,                                                 &
+           ONLY:  kappa
+       
+       USE grid_variables,                                                     &
+           ONLY:  dx, dy
+       
+       USE indices,                                                            &
+           ONLY:  i_left, i_right, j_north, j_south, nxl, nxlg, nxr, nxrg,     &
+                  nyn, nyng, nys, nysg, nzb, nzb_diff_s_inner,                 &
+                  nzb_diff_s_outer, nzt
+       
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i            !< 
+       INTEGER(iwp) ::  j            !< 
+       INTEGER(iwp) ::  k            !< 
+       INTEGER(iwp) ::  kk           !< 
+       INTEGER(iwp) ::  max_outer    !< 
+       INTEGER(iwp) ::  min_inner    !< 
+       INTEGER(iwp) ::  wall_index   !< 
+       
+       REAL(wp) ::  a           !< 
+       REAL(wp) ::  b           !< 
+       REAL(wp) ::  c1          !< 
+       REAL(wp) ::  c2          !< 
+       REAL(wp) ::  h1          !< 
+       REAL(wp) ::  h2          !< 
+       REAL(wp) ::  u_i         !< 
+       REAL(wp) ::  v_i         !< 
+       REAL(wp) ::  us_wall     !< 
+       REAL(wp) ::  vel_total   !< 
+       REAL(wp) ::  vel_zp      !< 
+       REAL(wp) ::  ws          !< 
+       REAL(wp) ::  zp          !< 
+       REAL(wp) ::  rifs        !< 
+
+       REAL(wp),                                                               &
+          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
+             wall   !< 
+       
+       REAL(wp),                                                               &
+          DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::                              &
+             wall_flux   !< 
+
+
+       zp         = 0.5_wp * ( (a+c1) * dy + (b+c2) * dx )
+       wall_flux  = 0.0_wp
+       wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
+
+       min_inner = MINVAL( nzb_diff_s_inner(nys:nyn,nxl:nxr) ) - 1
+       max_outer = MAXVAL( nzb_diff_s_outer(nys:nyn,nxl:nxr) ) - 2
+
+       !$acc kernels present( nzb_diff_s_inner, nzb_diff_s_outer, rif_wall )   &
+       !$acc         present( u, v, w, wall, wall_flux, z0 )
+       DO  i = i_left, i_right
+          DO  j = j_south, j_north
+             DO  k = min_inner, max_outer
+!
+!--             All subsequent variables are computed for scalar locations
+                IF ( k >= nzb_diff_s_inner(j,i)-1  .AND.                       &
+                     k <= nzb_diff_s_outer(j,i)-2  .AND.                       &
+                     wall(j,i) /= 0.0_wp )         THEN
+!
+!--                (1) Compute rifs, u_i, v_i, and ws
+                   IF ( k == nzb_diff_s_inner(j,i)-1 )  THEN
+                      kk = nzb_diff_s_inner(j,i)-1
+                   ELSE
+                      kk = k-1
+                   ENDIF
+                   rifs  = 0.5_wp * (      rif_wall(k,j,i,wall_index) +        &
+                                      a  * rif_wall(k,j,i+1,1)        +        &
+                                      b  * rif_wall(k,j+1,i,2)        +        &
+                                      c1 * rif_wall(kk,j,i,3)         +        &
+                                      c2 * rif_wall(kk,j,i,4)                  &
+                                    )
+
+                   u_i   = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
+                   v_i   = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
+                   ws    = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
+!
+!--                (2) Compute wall-parallel absolute velocity vel_total and
+!--                interpolate appropriate velocity component vel_zp.
+                   vel_total = SQRT( ws**2 + (a+c1) * u_i**2 + (b+c2) * v_i**2 )
+                   vel_zp    = 0.5_wp * ( a * u_i + b * v_i + (c1+c2) * ws )
+!
+!--                (3) Compute wall friction velocity us_wall
+                   IF ( rifs >= 0.0_wp )  THEN
+
+!
+!--                   Stable stratification (and neutral)
+                      us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) +    &
+                                         5.0_wp * rifs * ( zp - z0(j,i) ) / zp &
+                                                    )
+                   ELSE
+
+!
+!--                   Unstable stratification
+                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
+                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
+
+                      us_wall = kappa * vel_total / (                          &
+                           LOG( zp / z0(j,i) ) -                               &
+                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
+                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
+                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
+                                                    )
+                   ENDIF
+
+!
+!--                Skip step (4) of wall_fluxes, because here rifs is already
+!--                available from (1)
+!
+!--                (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
+
+                   IF ( rifs >= 0.0_wp )  THEN
+
+!
+!--                   Stable stratification (and neutral)
+                      wall_flux(k,j,i) = kappa *  vel_zp / (                   &
+                                         LOG( zp/z0(j,i) ) +                   &
+                                         5.0_wp * rifs * ( zp-z0(j,i) ) / zp   &
+                                                           )
+                   ELSE
+
+!
+!--                   Unstable stratification
+                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
+                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
+
+                      wall_flux(k,j,i) = kappa * vel_zp / (                    &
+                           LOG( zp / z0(j,i) ) -                               &
+                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
+                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
+                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
+                                                          )
+                   ENDIF
+                   wall_flux(k,j,i) = - wall_flux(k,j,i) * us_wall
+
+                ENDIF
+
+             ENDDO
+          ENDDO
+       ENDDO
+       !$acc end kernels
+
+    END SUBROUTINE wall_fluxes_e_acc
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE wall_fluxes_e_ij( i, j, nzb_w, nzt_w, wall_flux, a, b, c1, c2 )
+
+       USE arrays_3d,                                                          &
+           ONLY:  rif_wall, u, v, w, z0
+       
+       USE control_parameters,                                                 &
+           ONLY:  kappa
+       
+       USE grid_variables,                                                     &
+           ONLY:  dx, dy
+       
+       USE indices,                                                            &
+           ONLY:  nzb, nzt
+       
+       USE kinds
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i            !< 
+       INTEGER(iwp) ::  j            !< 
+       INTEGER(iwp) ::  k            !< 
+       INTEGER(iwp) ::  kk           !< 
+       INTEGER(iwp) ::  nzb_w        !< 
+       INTEGER(iwp) ::  nzt_w        !< 
+       INTEGER(iwp) ::  wall_index   !< 
+       
+       REAL(wp) ::  a           !< 
+       REAL(wp) ::  b           !< 
+       REAL(wp) ::  c1          !< 
+       REAL(wp) ::  c2          !< 
+       REAL(wp) ::  h1          !< 
+       REAL(wp) ::  h2          !< 
+       REAL(wp) ::  u_i         !< 
+       REAL(wp) ::  v_i         !< 
+       REAL(wp) ::  us_wall     !< 
+       REAL(wp) ::  vel_total   !< 
+       REAL(wp) ::  vel_zp      !< 
+       REAL(wp) ::  ws          !< 
+       REAL(wp) ::  zp          !< 
+       REAL(wp) ::  rifs        !< 
+
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  wall_flux   !< 
+
+
+       zp         = 0.5_wp * ( (a+c1) * dy + (b+c2) * dx )
+       wall_flux  = 0.0_wp
+       wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
+
+!
+!--    All subsequent variables are computed for scalar locations.
+       DO  k = nzb_w, nzt_w
+
+!
+!--       (1) Compute rifs, u_i, v_i, and ws
+          IF ( k == nzb_w )  THEN
+             kk = nzb_w
+          ELSE
+             kk = k-1
+          ENDIF
+          rifs  = 0.5_wp * (      rif_wall(k,j,i,wall_index) +                 &
+                             a  * rif_wall(k,j,i+1,1)        +                 &
+                             b  * rif_wall(k,j+1,i,2)        +                 &
+                             c1 * rif_wall(kk,j,i,3)         +                 &
+                             c2 * rif_wall(kk,j,i,4)                           &
+                           )
+
+          u_i   = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
+          v_i   = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
+          ws    = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
+!
+!--       (2) Compute wall-parallel absolute velocity vel_total and
+!--       interpolate appropriate velocity component vel_zp.
+          vel_total = SQRT( ws**2 + (a+c1) * u_i**2 + (b+c2) * v_i**2 )
+          vel_zp    = 0.5_wp * ( a * u_i + b * v_i + (c1+c2) * ws )
+!
+!--       (3) Compute wall friction velocity us_wall
+          IF ( rifs >= 0.0_wp )  THEN
+
+!
+!--          Stable stratification (and neutral)
+             us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) +             &
+                                         5.0_wp * rifs * ( zp - z0(j,i) ) / zp &
+                                           )
+          ELSE
+
+!
+!--          Unstable stratification
+             h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
+             h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
+
+             us_wall = kappa * vel_total / (                                   &
+                  LOG( zp / z0(j,i) ) -                                        &
+                  LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (             &
+                       ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +         &
+                       2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )                    &
+                                           )
+          ENDIF
+
+!
+!--       Skip step (4) of wall_fluxes, because here rifs is already
+!--       available from (1)
+!
+!--       (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
+!--       First interpolate the velocity (this is different from 
+!--       subroutine wall_fluxes because fluxes in subroutine 
+!--       wall_fluxes_e are defined at scalar locations).
+          vel_zp = 0.5_wp * (       a * ( u(k,j,i) + u(k,j,i+1) ) +            &
+                                    b * ( v(k,j,i) + v(k,j+1,i) ) +            &
+                              (c1+c2) * ( w(k,j,i) + w(k-1,j,i) )              &
+                            )
+
+          IF ( rifs >= 0.0_wp )  THEN
+
+!
+!--          Stable stratification (and neutral)
+             wall_flux(k) = kappa *  vel_zp /                                  &
+                     ( LOG( zp/z0(j,i) ) + 5.0_wp * rifs * ( zp-z0(j,i) ) / zp )
+          ELSE
+
+!
+!--          Unstable stratification
+             h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
+             h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
+
+             wall_flux(k) = kappa * vel_zp / (                                 &
+                  LOG( zp / z0(j,i) ) -                                        &
+                  LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (             &
+                       ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +         &
+                       2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )                    &
+                                             )
+          ENDIF
+          wall_flux(k) = - wall_flux(k) * us_wall
+
+       ENDDO
+
+    END SUBROUTINE wall_fluxes_e_ij
+
+ END MODULE wall_fluxes_mod
Index: lm/trunk/SOURCE/wall_fluxes_mod.f90
===================================================================
--- /palm/trunk/SOURCE/wall_fluxes_mod.f90	(revision 1872)
+++ 	(revision )
@@ -1,1108 +1,0 @@
-!> @file wall_fluxes_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms
-! of the GNU General Public License as published by the Free Software Foundation,
-! either version 3 of the License, or (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2016 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1691 2015-10-26 16:17:44Z maronga
-! Renamed rif_min and rif_max with zeta_min and zeta_max, respectively.
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1374 2014-04-25 12:55:07Z raasch
-! pt removed from acc-present-list
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements, 
-! kinds are defined in new module kinds, 
-! old module precision_kind is removed,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements 
-!
-! 1257 2013-11-08 15:18:40Z raasch
-! openacc loop and loop vector clauses removed
-!
-! 1153 2013-05-10 14:33:08Z raasch
-! code adjustments of accelerator version required by PGI 12.3 / CUDA 5.0
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! accelerator version (*_acc) added
-!
-! Initial version (2007/03/07)
-!
-! Description:
-! ------------
-!> Calculates momentum fluxes at vertical walls assuming Monin-Obukhov
-!> similarity.
-!> Indices: usvs a=1, vsus b=1, wsvs c1=1, wsus c2=1 (other=0).
-!> The all-gridpoint version of wall_fluxes_e is not used so far, because
-!> it gives slightly different results from the ij-version for some unknown
-!> reason.
-!>
-!> @todo Rename rif to zeta throughout the routine
-!------------------------------------------------------------------------------!
- MODULE wall_fluxes_mod
- 
-    PRIVATE
-    PUBLIC wall_fluxes, wall_fluxes_acc, wall_fluxes_e, wall_fluxes_e_acc
-    
-    INTERFACE wall_fluxes
-       MODULE PROCEDURE wall_fluxes
-       MODULE PROCEDURE wall_fluxes_ij
-    END INTERFACE wall_fluxes
-    
-    INTERFACE wall_fluxes_acc
-       MODULE PROCEDURE wall_fluxes_acc
-    END INTERFACE wall_fluxes_acc
-
-    INTERFACE wall_fluxes_e
-       MODULE PROCEDURE wall_fluxes_e
-       MODULE PROCEDURE wall_fluxes_e_ij
-    END INTERFACE wall_fluxes_e
- 
-    INTERFACE wall_fluxes_e_acc
-       MODULE PROCEDURE wall_fluxes_e_acc
-    END INTERFACE wall_fluxes_e_acc
-
- CONTAINS
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE wall_fluxes( wall_flux, a, b, c1, c2, nzb_uvw_inner,            &
-                            nzb_uvw_outer, wall )
-
-       USE arrays_3d,                                                          &
-           ONLY:  rif_wall, u, v, w, z0, pt
-       
-       USE control_parameters,                                                 &
-           ONLY:  g, kappa, zeta_max, zeta_min
-       
-       USE grid_variables,                                                     &
-           ONLY:  dx, dy
-       
-       USE indices,                                                            &
-           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
-       
-       USE kinds
-       
-       USE statistics,                                                         &
-           ONLY:  hom
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i            !< 
-       INTEGER(iwp) ::  j            !< 
-       INTEGER(iwp) ::  k            !< 
-       INTEGER(iwp) ::  wall_index   !< 
-
-       INTEGER(iwp),                                                           &
-          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
-             nzb_uvw_inner   !< 
-       INTEGER(iwp),                                                           &
-          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
-             nzb_uvw_outer   !< 
-       
-       REAL(wp) ::  a           !< 
-       REAL(wp) ::  b           !< 
-       REAL(wp) ::  c1          !< 
-       REAL(wp) ::  c2          !< 
-       REAL(wp) ::  h1          !< 
-       REAL(wp) ::  h2          !< 
-       REAL(wp) ::  zp          !< 
-       REAL(wp) ::  pts         !< 
-       REAL(wp) ::  pt_i        !< 
-       REAL(wp) ::  rifs        !< 
-       REAL(wp) ::  u_i         !< 
-       REAL(wp) ::  v_i         !< 
-       REAL(wp) ::  us_wall     !< 
-       REAL(wp) ::  vel_total   !< 
-       REAL(wp) ::  ws          !< 
-       REAL(wp) ::  wspts       !< 
-
-       REAL(wp),                                                               &
-          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
-             wall   !< 
-       
-       REAL(wp),                                                               &
-          DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::                              &
-             wall_flux   !< 
-
-
-       zp         = 0.5_wp * ( (a+c1) * dy + (b+c2) * dx )
-       wall_flux  = 0.0_wp
-       wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-
-             IF ( wall(j,i) /= 0.0_wp )  THEN
-!
-!--             All subsequent variables are computed for the respective
-!--             location where the respective flux is defined.
-                DO  k = nzb_uvw_inner(j,i)+1, nzb_uvw_outer(j,i)
-
-!
-!--                (1) Compute rifs, u_i, v_i, ws, pt' and w'pt'
-                   rifs  = rif_wall(k,j,i,wall_index)
-
-                   u_i   = a * u(k,j,i) + c1 * 0.25_wp *                       &
-                           ( u(k+1,j,i+1) + u(k+1,j,i) + u(k,j,i+1) + u(k,j,i) )
-
-                   v_i   = b * v(k,j,i) + c2 * 0.25_wp *                       &
-                           ( v(k+1,j+1,i) + v(k+1,j,i) + v(k,j+1,i) + v(k,j,i) )
-
-                   ws    = ( c1 + c2 ) * w(k,j,i) + 0.25_wp * (                &
-                     a * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) ) &
-                   + b * ( w(k-1,j-1,i) + w(k-1,j,i) + w(k,j-1,i) + w(k,j,i) ) &
-                                                              )
-                   pt_i  = 0.5_wp * ( pt(k,j,i) + a *  pt(k,j,i-1) +           &
-                                   b * pt(k,j-1,i) + ( c1 + c2 ) * pt(k+1,j,i) )
-
-                   pts   = pt_i - hom(k,1,4,0)
-                   wspts = ws * pts
-
-!
-!--                (2) Compute wall-parallel absolute velocity vel_total
-                   vel_total = SQRT( ws**2 + (a+c1) * u_i**2 + (b+c2) * v_i**2 )
-
-!
-!--                (3) Compute wall friction velocity us_wall
-                   IF ( rifs >= 0.0_wp )  THEN
-
-!
-!--                   Stable stratification (and neutral)
-                      us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) +    &
-                                         5.0_wp * rifs * ( zp - z0(j,i) ) / zp &
-                                                    )
-                   ELSE
-
-!
-!--                   Unstable stratification
-                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
-                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
-
-                      us_wall = kappa * vel_total / (                          &
-                           LOG( zp / z0(j,i) ) -                               &
-                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
-                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
-                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
-                                                    )
-                   ENDIF
-
-!
-!--                (4) Compute zp/L (corresponds to neutral Richardson flux
-!--                    number rifs)
-                   rifs = -1.0_wp * zp * kappa * g * wspts /                   &
-                          ( pt_i * ( us_wall**3 + 1E-30 ) )
-
-!
-!--                Limit the value range of the Richardson numbers.
-!--                This is necessary for very small velocities (u,w --> 0),
-!--                because the absolute value of rif can then become very
-!--                large, which in consequence would result in very large
-!--                shear stresses and very small momentum fluxes (both are
-!--                generally unrealistic).
-                   IF ( rifs < zeta_min )  rifs = zeta_min
-                   IF ( rifs > zeta_max )  rifs = zeta_max
-
-!
-!--                (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
-                   IF ( rifs >= 0.0_wp )  THEN
-
-!
-!--                   Stable stratification (and neutral)
-                      wall_flux(k,j,i) = kappa *                               &
-                              ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / &
-                              (  LOG( zp / z0(j,i) ) +                         &
-                                 5.0_wp * rifs * ( zp - z0(j,i) ) / zp         &
-                              )
-                   ELSE
-
-!
-!--                   Unstable stratification
-                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
-                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
-
-                      wall_flux(k,j,i) = kappa *                               &
-                           ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / (  &
-                           LOG( zp / z0(j,i) ) -                               &
-                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
-                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
-                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
-                                                                            )
-                   ENDIF
-                   wall_flux(k,j,i) = -wall_flux(k,j,i) * us_wall
-
-!
-!--                store rifs for next time step
-                   rif_wall(k,j,i,wall_index) = rifs
-
-                ENDDO
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE wall_fluxes
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points - accelerator version
-!------------------------------------------------------------------------------!
-    SUBROUTINE wall_fluxes_acc( wall_flux, a, b, c1, c2, nzb_uvw_inner,        &
-                                nzb_uvw_outer, wall )
-
-       USE arrays_3d,                                                          &
-           ONLY:  rif_wall, pt, u, v, w, z0
-       
-       USE control_parameters,                                                 &
-           ONLY:  g, kappa, zeta_max, zeta_min
-       
-       USE grid_variables,                                                     &
-           ONLY:  dx, dy
-       
-       USE indices,                                                            &
-           ONLY:  i_left, i_right, j_north, j_south, nxl, nxlg, nxr, nxrg,     &
-                  nyn, nyng, nys, nysg, nzb, nzt
-       
-       USE kinds
-       
-       USE statistics,                                                         &
-           ONLY:  hom
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i            !< 
-       INTEGER(iwp) ::  j            !< 
-       INTEGER(iwp) ::  k            !< 
-       INTEGER(iwp) ::  max_outer    !< 
-       INTEGER(iwp) ::  min_inner    !< 
-       INTEGER(iwp) ::  wall_index   !< 
-
-       INTEGER(iwp),                                                           &
-          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
-             nzb_uvw_inner   !< 
-       INTEGER(iwp),                                                           &
-          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
-             nzb_uvw_outer   !< 
-       
-       REAL(wp) ::  a           !< 
-       REAL(wp) ::  b           !< 
-       REAL(wp) ::  c1          !< 
-       REAL(wp) ::  c2          !< 
-       REAL(wp) ::  h1          !< 
-       REAL(wp) ::  h2          !< 
-       REAL(wp) ::  zp          !< 
-       REAL(wp) ::  pts         !< 
-       REAL(wp) ::  pt_i        !< 
-       REAL(wp) ::  rifs        !< 
-       REAL(wp) ::  u_i         !< 
-       REAL(wp) ::  v_i         !< 
-       REAL(wp) ::  us_wall     !< 
-       REAL(wp) ::  vel_total   !< 
-       REAL(wp) ::  ws          !< 
-       REAL(wp) ::  wspts       !< 
-
-       REAL(wp),                                                               &
-          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
-             wall   !< 
-       
-       REAL(wp),                                                               &
-          DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::                              &
-             wall_flux   !< 
-
-
-       zp         = 0.5_wp * ( (a+c1) * dy + (b+c2) * dx )
-       wall_flux  = 0.0_wp
-       wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
-
-       min_inner = MINVAL( nzb_uvw_inner(nys:nyn,nxl:nxr) ) + 1
-       max_outer = MINVAL( nzb_uvw_outer(nys:nyn,nxl:nxr) )
-
-       !$acc kernels present( hom, nzb_uvw_inner, nzb_uvw_outer, pt, rif_wall ) &
-       !$acc         present( u, v, w, wall, wall_flux, z0 )
-       !$acc loop independent
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-
-             IF ( wall(j,i) /= 0.0_wp )  THEN
-!
-!--             All subsequent variables are computed for the respective
-!--             location where the respective flux is defined.
-                !$acc loop independent
-                DO  k = nzb_uvw_inner(j,i)+1, nzb_uvw_outer(j,i)
-
-!
-!--                (1) Compute rifs, u_i, v_i, ws, pt' and w'pt'
-                   rifs  = rif_wall(k,j,i,wall_index)
-
-                   u_i   = a * u(k,j,i) + c1 * 0.25_wp *                       &
-                           ( u(k+1,j,i+1) + u(k+1,j,i) + u(k,j,i+1) + u(k,j,i) )
-
-                   v_i   = b * v(k,j,i) + c2 * 0.25_wp *                       &
-                           ( v(k+1,j+1,i) + v(k+1,j,i) + v(k,j+1,i) + v(k,j,i) )
-
-                   ws    = ( c1 + c2 ) * w(k,j,i) + 0.25_wp * (                &
-                     a * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) ) &
-                   + b * ( w(k-1,j-1,i) + w(k-1,j,i) + w(k,j-1,i) + w(k,j,i) ) &
-                                                              )
-                   pt_i  = 0.5_wp * ( pt(k,j,i) + a *  pt(k,j,i-1) +           &
-                                   b * pt(k,j-1,i) + ( c1 + c2 ) * pt(k+1,j,i) )
-
-                   pts   = pt_i - hom(k,1,4,0)
-                   wspts = ws * pts
-
-!
-!--                (2) Compute wall-parallel absolute velocity vel_total
-                   vel_total = SQRT( ws**2 + (a+c1) * u_i**2 + (b+c2) * v_i**2 )
-
-!
-!--                (3) Compute wall friction velocity us_wall
-                   IF ( rifs >= 0.0_wp )  THEN
-
-!
-!--                   Stable stratification (and neutral)
-                      us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) +    &
-                                         5.0_wp * rifs * ( zp - z0(j,i) ) / zp &
-                                                    )
-                   ELSE
-
-!
-!--                   Unstable stratification
-                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
-                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
-
-                      us_wall = kappa * vel_total / (                          &
-                           LOG( zp / z0(j,i) ) -                               &
-                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
-                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
-                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
-                                                    )
-                   ENDIF
-
-!
-!--                (4) Compute zp/L (corresponds to neutral Richardson flux
-!--                    number rifs)
-                   rifs = -1.0_wp * zp * kappa * g * wspts /                   &
-                          ( pt_i * ( us_wall**3 + 1E-30 ) )
-
-!
-!--                Limit the value range of the Richardson numbers.
-!--                This is necessary for very small velocities (u,w --> 0),
-!--                because the absolute value of rif can then become very
-!--                large, which in consequence would result in very large
-!--                shear stresses and very small momentum fluxes (both are
-!--                generally unrealistic).
-                   IF ( rifs < zeta_min )  rifs = zeta_min
-                   IF ( rifs > zeta_max )  rifs = zeta_max
-
-!
-!--                (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
-                   IF ( rifs >= 0.0_wp )  THEN
-
-!
-!--                   Stable stratification (and neutral)
-                      wall_flux(k,j,i) = kappa *                               &
-                              ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / &
-                              (  LOG( zp / z0(j,i) ) +                         &
-                                 5.0_wp * rifs * ( zp - z0(j,i) ) / zp         &
-                              )
-                   ELSE
-
-!
-!--                   Unstable stratification
-                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
-                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
-
-                      wall_flux(k,j,i) = kappa *                               &
-                           ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / (  &
-                           LOG( zp / z0(j,i) ) -                               &
-                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
-                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
-                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
-                                                                            )
-                   ENDIF
-                   wall_flux(k,j,i) = -wall_flux(k,j,i) * us_wall
-
-!
-!--                store rifs for next time step
-                   rif_wall(k,j,i,wall_index) = rifs
-
-                ENDDO
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-       !$acc end kernels
-
-    END SUBROUTINE wall_fluxes_acc
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE wall_fluxes_ij( i, j, nzb_w, nzt_w, wall_flux, a, b, c1, c2 )
-
-       USE arrays_3d,                                                          &
-           ONLY:  rif_wall, pt, u, v, w, z0
-       
-       USE control_parameters,                                                 &
-           ONLY:  g, kappa, zeta_max, zeta_min
-       
-       USE grid_variables,                                                     &
-           ONLY:  dx, dy
-       
-       USE indices,                                                            &
-           ONLY:  nzb, nzt
-       
-       USE kinds
-       
-       USE statistics,                                                         &
-           ONLY:  hom
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i            !< 
-       INTEGER(iwp) ::  j            !< 
-       INTEGER(iwp) ::  k            !< 
-       INTEGER(iwp) ::  nzb_w        !< 
-       INTEGER(iwp) ::  nzt_w        !< 
-       INTEGER(iwp) ::  wall_index   !< 
-       
-       REAL(wp) ::  a           !< 
-       REAL(wp) ::  b           !< 
-       REAL(wp) ::  c1          !< 
-       REAL(wp) ::  c2          !< 
-       REAL(wp) ::  h1          !< 
-       REAL(wp) ::  h2          !< 
-       REAL(wp) ::  zp          !< 
-       REAL(wp) ::  pts         !< 
-       REAL(wp) ::  pt_i        !< 
-       REAL(wp) ::  rifs        !< 
-       REAL(wp) ::  u_i         !< 
-       REAL(wp) ::  v_i         !< 
-       REAL(wp) ::  us_wall     !< 
-       REAL(wp) ::  vel_total   !< 
-       REAL(wp) ::  ws          !< 
-       REAL(wp) ::  wspts       !< 
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  wall_flux   !< 
-
-
-       zp         = 0.5_wp * ( (a+c1) * dy + (b+c2) * dx )
-       wall_flux  = 0.0_wp
-       wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
-
-!
-!--    All subsequent variables are computed for the respective location where 
-!--    the respective flux is defined.
-       DO  k = nzb_w, nzt_w
-
-!
-!--       (1) Compute rifs, u_i, v_i, ws, pt' and w'pt'
-          rifs  = rif_wall(k,j,i,wall_index)
-
-          u_i   = a * u(k,j,i) + c1 * 0.25_wp *                                &
-                  ( u(k+1,j,i+1) + u(k+1,j,i) + u(k,j,i+1) + u(k,j,i) )
-
-          v_i   = b * v(k,j,i) + c2 * 0.25_wp *                                &
-                  ( v(k+1,j+1,i) + v(k+1,j,i) + v(k,j+1,i) + v(k,j,i) )
-
-          ws    = ( c1 + c2 ) * w(k,j,i) + 0.25_wp * (                         &
-                     a * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) ) &
-                   + b * ( w(k-1,j-1,i) + w(k-1,j,i) + w(k,j-1,i) + w(k,j,i) ) &
-                                                     )
-          pt_i  = 0.5_wp * ( pt(k,j,i) + a *  pt(k,j,i-1) + b * pt(k,j-1,i)    &
-                          + ( c1 + c2 ) * pt(k+1,j,i) )
-
-          pts   = pt_i - hom(k,1,4,0)
-          wspts = ws * pts
-
-!
-!--       (2) Compute wall-parallel absolute velocity vel_total
-          vel_total = SQRT( ws**2 + ( a+c1 ) * u_i**2 + ( b+c2 ) * v_i**2 )
-
-!
-!--       (3) Compute wall friction velocity us_wall
-          IF ( rifs >= 0.0_wp )  THEN
-
-!
-!--          Stable stratification (and neutral)
-             us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) +             &
-                                         5.0_wp * rifs * ( zp - z0(j,i) ) / zp &
-                                           )
-          ELSE
-
-!
-!--          Unstable stratification
-             h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
-             h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
-
-             us_wall = kappa * vel_total / (                                   &
-                  LOG( zp / z0(j,i) ) -                                        &
-                  LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (             &
-                       ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +         &
-                       2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )                    &
-                                           )
-          ENDIF
-
-!
-!--       (4) Compute zp/L (corresponds to neutral Richardson flux number 
-!--           rifs)
-          rifs = -1.0_wp * zp * kappa * g * wspts /                            &
-                  ( pt_i * (us_wall**3 + 1E-30) )
-
-!
-!--       Limit the value range of the Richardson numbers.
-!--       This is necessary for very small velocities (u,w --> 0), because
-!--       the absolute value of rif can then become very large, which in
-!--       consequence would result in very large shear stresses and very
-!--       small momentum fluxes (both are generally unrealistic).
-          IF ( rifs < zeta_min )  rifs = zeta_min
-          IF ( rifs > zeta_max )  rifs = zeta_max
-
-!
-!--       (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
-          IF ( rifs >= 0.0_wp )  THEN
-
-!
-!--          Stable stratification (and neutral)
-             wall_flux(k) = kappa *                                            &
-                            ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) /   &
-                            (  LOG( zp / z0(j,i) ) +                           &
-                               5.0_wp * rifs * ( zp - z0(j,i) ) / zp           &
-                            )
-          ELSE
-
-!
-!--          Unstable stratification
-             h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
-             h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
-
-             wall_flux(k) = kappa *                                            &
-                  ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / (           &
-                  LOG( zp / z0(j,i) ) -                                        &
-                  LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (             &
-                       ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +         &
-                       2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )                    &
-                                                                   )
-          ENDIF
-          wall_flux(k) = -wall_flux(k) * us_wall
-
-!
-!--       store rifs for next time step
-          rif_wall(k,j,i,wall_index) = rifs
-
-       ENDDO
-
-    END SUBROUTINE wall_fluxes_ij
-
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!> Calculates momentum fluxes at vertical walls for routine production_e
-!> assuming Monin-Obukhov similarity.
-!> Indices: usvs a=1, vsus b=1, wsvs c1=1, wsus c2=1 (other=0).
-!------------------------------------------------------------------------------!
-
-    SUBROUTINE wall_fluxes_e( wall_flux, a, b, c1, c2, wall )
-
-
-       USE arrays_3d,                                                          &
-           ONLY:  rif_wall, u, v, w, z0
-       
-       USE control_parameters,                                                 &
-           ONLY:  kappa
-       
-       USE grid_variables,                                                     &
-           ONLY:  dx, dy
-       
-       USE indices,                                                            &
-           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb,             &
-                  nzb_diff_s_inner, nzb_diff_s_outer, nzt
-       
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i            !< 
-       INTEGER(iwp) ::  j            !< 
-       INTEGER(iwp) ::  k            !< 
-       INTEGER(iwp) ::  kk           !< 
-       INTEGER(iwp) ::  wall_index   !< 
-       
-       REAL(wp) ::  a           !< 
-       REAL(wp) ::  b           !< 
-       REAL(wp) ::  c1          !< 
-       REAL(wp) ::  c2          !< 
-       REAL(wp) ::  h1          !< 
-       REAL(wp) ::  h2          !< 
-       REAL(wp) ::  u_i         !< 
-       REAL(wp) ::  v_i         !< 
-       REAL(wp) ::  us_wall     !< 
-       REAL(wp) ::  vel_total   !< 
-       REAL(wp) ::  vel_zp      !< 
-       REAL(wp) ::  ws          !< 
-       REAL(wp) ::  zp          !< 
-       REAL(wp) ::  rifs        !< 
-
-       REAL(wp),                                                               &
-          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
-             wall   !< 
-       
-       REAL(wp),                                                               &
-          DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::                              &
-             wall_flux   !< 
-
-
-       zp         = 0.5_wp * ( (a+c1) * dy + (b+c2) * dx )
-       wall_flux  = 0.0_wp
-       wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
-
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-
-             IF ( wall(j,i) /= 0.0_wp )  THEN
-!
-!--             All subsequent variables are computed for scalar locations.
-                DO  k = nzb_diff_s_inner(j,i)-1, nzb_diff_s_outer(j,i)-2
-!
-!--                (1) Compute rifs, u_i, v_i, and ws
-                   IF ( k == nzb_diff_s_inner(j,i)-1 )  THEN
-                      kk = nzb_diff_s_inner(j,i)-1
-                   ELSE
-                      kk = k-1
-                   ENDIF
-                   rifs  = 0.5_wp * (      rif_wall(k,j,i,wall_index) +        &
-                                      a  * rif_wall(k,j,i+1,1)        +        &
-                                      b  * rif_wall(k,j+1,i,2)        +        &
-                                      c1 * rif_wall(kk,j,i,3)         +        &
-                                      c2 * rif_wall(kk,j,i,4)                  &
-                                    )
-
-                   u_i   = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
-                   v_i   = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
-                   ws    = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
-!
-!--                (2) Compute wall-parallel absolute velocity vel_total and
-!--                interpolate appropriate velocity component vel_zp.
-                   vel_total = SQRT( ws**2 + (a+c1) * u_i**2 + (b+c2) * v_i**2 )
-                   vel_zp    = 0.5_wp * ( a * u_i + b * v_i + (c1+c2) * ws )
-!
-!--                (3) Compute wall friction velocity us_wall
-                   IF ( rifs >= 0.0_wp )  THEN
-
-!
-!--                   Stable stratification (and neutral)
-                      us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) +    &
-                                         5.0_wp * rifs * ( zp - z0(j,i) ) / zp &
-                                                    )
-                   ELSE
-
-!
-!--                   Unstable stratification
-                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
-                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
-
-                      us_wall = kappa * vel_total / (                          &
-                           LOG( zp / z0(j,i) ) -                               &
-                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
-                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
-                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
-                                                    )
-                   ENDIF
-
-!
-!--                Skip step (4) of wall_fluxes, because here rifs is already
-!--                available from (1)
-!
-!--                (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
-
-                   IF ( rifs >= 0.0_wp )  THEN
-
-!
-!--                   Stable stratification (and neutral)
-                      wall_flux(k,j,i) = kappa * vel_zp / ( LOG( zp/z0(j,i) ) +&
-                                         5.0_wp * rifs * ( zp-z0(j,i) ) / zp )
-                   ELSE
-
-!
-!--                   Unstable stratification
-                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
-                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
-
-                      wall_flux(k,j,i) = kappa * vel_zp / (                    &
-                           LOG( zp / z0(j,i) ) -                               &
-                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
-                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
-                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
-                                                          )
-                   ENDIF
-                   wall_flux(k,j,i) = - wall_flux(k,j,i) * us_wall
-
-                ENDDO
-
-             ENDIF
-
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE wall_fluxes_e
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points - accelerator version
-!> Calculates momentum fluxes at vertical walls for routine production_e
-!> assuming Monin-Obukhov similarity.
-!> Indices: usvs a=1, vsus b=1, wsvs c1=1, wsus c2=1 (other=0).
-!------------------------------------------------------------------------------!
-    SUBROUTINE wall_fluxes_e_acc( wall_flux, a, b, c1, c2, wall )
-
-
-       USE arrays_3d,                                                          &
-           ONLY:  rif_wall, u, v, w, z0
-       
-       USE control_parameters,                                                 &
-           ONLY:  kappa
-       
-       USE grid_variables,                                                     &
-           ONLY:  dx, dy
-       
-       USE indices,                                                            &
-           ONLY:  i_left, i_right, j_north, j_south, nxl, nxlg, nxr, nxrg,     &
-                  nyn, nyng, nys, nysg, nzb, nzb_diff_s_inner,                 &
-                  nzb_diff_s_outer, nzt
-       
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i            !< 
-       INTEGER(iwp) ::  j            !< 
-       INTEGER(iwp) ::  k            !< 
-       INTEGER(iwp) ::  kk           !< 
-       INTEGER(iwp) ::  max_outer    !< 
-       INTEGER(iwp) ::  min_inner    !< 
-       INTEGER(iwp) ::  wall_index   !< 
-       
-       REAL(wp) ::  a           !< 
-       REAL(wp) ::  b           !< 
-       REAL(wp) ::  c1          !< 
-       REAL(wp) ::  c2          !< 
-       REAL(wp) ::  h1          !< 
-       REAL(wp) ::  h2          !< 
-       REAL(wp) ::  u_i         !< 
-       REAL(wp) ::  v_i         !< 
-       REAL(wp) ::  us_wall     !< 
-       REAL(wp) ::  vel_total   !< 
-       REAL(wp) ::  vel_zp      !< 
-       REAL(wp) ::  ws          !< 
-       REAL(wp) ::  zp          !< 
-       REAL(wp) ::  rifs        !< 
-
-       REAL(wp),                                                               &
-          DIMENSION(nysg:nyng,nxlg:nxrg) ::                                    &
-             wall   !< 
-       
-       REAL(wp),                                                               &
-          DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::                              &
-             wall_flux   !< 
-
-
-       zp         = 0.5_wp * ( (a+c1) * dy + (b+c2) * dx )
-       wall_flux  = 0.0_wp
-       wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
-
-       min_inner = MINVAL( nzb_diff_s_inner(nys:nyn,nxl:nxr) ) - 1
-       max_outer = MAXVAL( nzb_diff_s_outer(nys:nyn,nxl:nxr) ) - 2
-
-       !$acc kernels present( nzb_diff_s_inner, nzb_diff_s_outer, rif_wall )   &
-       !$acc         present( u, v, w, wall, wall_flux, z0 )
-       DO  i = i_left, i_right
-          DO  j = j_south, j_north
-             DO  k = min_inner, max_outer
-!
-!--             All subsequent variables are computed for scalar locations
-                IF ( k >= nzb_diff_s_inner(j,i)-1  .AND.                       &
-                     k <= nzb_diff_s_outer(j,i)-2  .AND.                       &
-                     wall(j,i) /= 0.0_wp )         THEN
-!
-!--                (1) Compute rifs, u_i, v_i, and ws
-                   IF ( k == nzb_diff_s_inner(j,i)-1 )  THEN
-                      kk = nzb_diff_s_inner(j,i)-1
-                   ELSE
-                      kk = k-1
-                   ENDIF
-                   rifs  = 0.5_wp * (      rif_wall(k,j,i,wall_index) +        &
-                                      a  * rif_wall(k,j,i+1,1)        +        &
-                                      b  * rif_wall(k,j+1,i,2)        +        &
-                                      c1 * rif_wall(kk,j,i,3)         +        &
-                                      c2 * rif_wall(kk,j,i,4)                  &
-                                    )
-
-                   u_i   = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
-                   v_i   = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
-                   ws    = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
-!
-!--                (2) Compute wall-parallel absolute velocity vel_total and
-!--                interpolate appropriate velocity component vel_zp.
-                   vel_total = SQRT( ws**2 + (a+c1) * u_i**2 + (b+c2) * v_i**2 )
-                   vel_zp    = 0.5_wp * ( a * u_i + b * v_i + (c1+c2) * ws )
-!
-!--                (3) Compute wall friction velocity us_wall
-                   IF ( rifs >= 0.0_wp )  THEN
-
-!
-!--                   Stable stratification (and neutral)
-                      us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) +    &
-                                         5.0_wp * rifs * ( zp - z0(j,i) ) / zp &
-                                                    )
-                   ELSE
-
-!
-!--                   Unstable stratification
-                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
-                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
-
-                      us_wall = kappa * vel_total / (                          &
-                           LOG( zp / z0(j,i) ) -                               &
-                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
-                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
-                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
-                                                    )
-                   ENDIF
-
-!
-!--                Skip step (4) of wall_fluxes, because here rifs is already
-!--                available from (1)
-!
-!--                (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
-
-                   IF ( rifs >= 0.0_wp )  THEN
-
-!
-!--                   Stable stratification (and neutral)
-                      wall_flux(k,j,i) = kappa *  vel_zp / (                   &
-                                         LOG( zp/z0(j,i) ) +                   &
-                                         5.0_wp * rifs * ( zp-z0(j,i) ) / zp   &
-                                                           )
-                   ELSE
-
-!
-!--                   Unstable stratification
-                      h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
-                      h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
-
-                      wall_flux(k,j,i) = kappa * vel_zp / (                    &
-                           LOG( zp / z0(j,i) ) -                               &
-                           LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (    &
-                                ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +&
-                                2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )           &
-                                                          )
-                   ENDIF
-                   wall_flux(k,j,i) = - wall_flux(k,j,i) * us_wall
-
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-       !$acc end kernels
-
-    END SUBROUTINE wall_fluxes_e_acc
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE wall_fluxes_e_ij( i, j, nzb_w, nzt_w, wall_flux, a, b, c1, c2 )
-
-       USE arrays_3d,                                                          &
-           ONLY:  rif_wall, u, v, w, z0
-       
-       USE control_parameters,                                                 &
-           ONLY:  kappa
-       
-       USE grid_variables,                                                     &
-           ONLY:  dx, dy
-       
-       USE indices,                                                            &
-           ONLY:  nzb, nzt
-       
-       USE kinds
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i            !< 
-       INTEGER(iwp) ::  j            !< 
-       INTEGER(iwp) ::  k            !< 
-       INTEGER(iwp) ::  kk           !< 
-       INTEGER(iwp) ::  nzb_w        !< 
-       INTEGER(iwp) ::  nzt_w        !< 
-       INTEGER(iwp) ::  wall_index   !< 
-       
-       REAL(wp) ::  a           !< 
-       REAL(wp) ::  b           !< 
-       REAL(wp) ::  c1          !< 
-       REAL(wp) ::  c2          !< 
-       REAL(wp) ::  h1          !< 
-       REAL(wp) ::  h2          !< 
-       REAL(wp) ::  u_i         !< 
-       REAL(wp) ::  v_i         !< 
-       REAL(wp) ::  us_wall     !< 
-       REAL(wp) ::  vel_total   !< 
-       REAL(wp) ::  vel_zp      !< 
-       REAL(wp) ::  ws          !< 
-       REAL(wp) ::  zp          !< 
-       REAL(wp) ::  rifs        !< 
-
-       REAL(wp), DIMENSION(nzb:nzt+1) ::  wall_flux   !< 
-
-
-       zp         = 0.5_wp * ( (a+c1) * dy + (b+c2) * dx )
-       wall_flux  = 0.0_wp
-       wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
-
-!
-!--    All subsequent variables are computed for scalar locations.
-       DO  k = nzb_w, nzt_w
-
-!
-!--       (1) Compute rifs, u_i, v_i, and ws
-          IF ( k == nzb_w )  THEN
-             kk = nzb_w
-          ELSE
-             kk = k-1
-          ENDIF
-          rifs  = 0.5_wp * (      rif_wall(k,j,i,wall_index) +                 &
-                             a  * rif_wall(k,j,i+1,1)        +                 &
-                             b  * rif_wall(k,j+1,i,2)        +                 &
-                             c1 * rif_wall(kk,j,i,3)         +                 &
-                             c2 * rif_wall(kk,j,i,4)                           &
-                           )
-
-          u_i   = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
-          v_i   = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
-          ws    = 0.5_wp * ( w(k,j,i) + w(k-1,j,i) )
-!
-!--       (2) Compute wall-parallel absolute velocity vel_total and
-!--       interpolate appropriate velocity component vel_zp.
-          vel_total = SQRT( ws**2 + (a+c1) * u_i**2 + (b+c2) * v_i**2 )
-          vel_zp    = 0.5_wp * ( a * u_i + b * v_i + (c1+c2) * ws )
-!
-!--       (3) Compute wall friction velocity us_wall
-          IF ( rifs >= 0.0_wp )  THEN
-
-!
-!--          Stable stratification (and neutral)
-             us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) +             &
-                                         5.0_wp * rifs * ( zp - z0(j,i) ) / zp &
-                                           )
-          ELSE
-
-!
-!--          Unstable stratification
-             h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
-             h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
-
-             us_wall = kappa * vel_total / (                                   &
-                  LOG( zp / z0(j,i) ) -                                        &
-                  LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (             &
-                       ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +         &
-                       2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )                    &
-                                           )
-          ENDIF
-
-!
-!--       Skip step (4) of wall_fluxes, because here rifs is already
-!--       available from (1)
-!
-!--       (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
-!--       First interpolate the velocity (this is different from 
-!--       subroutine wall_fluxes because fluxes in subroutine 
-!--       wall_fluxes_e are defined at scalar locations).
-          vel_zp = 0.5_wp * (       a * ( u(k,j,i) + u(k,j,i+1) ) +            &
-                                    b * ( v(k,j,i) + v(k,j+1,i) ) +            &
-                              (c1+c2) * ( w(k,j,i) + w(k-1,j,i) )              &
-                            )
-
-          IF ( rifs >= 0.0_wp )  THEN
-
-!
-!--          Stable stratification (and neutral)
-             wall_flux(k) = kappa *  vel_zp /                                  &
-                     ( LOG( zp/z0(j,i) ) + 5.0_wp * rifs * ( zp-z0(j,i) ) / zp )
-          ELSE
-
-!
-!--          Unstable stratification
-             h1 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs ) )
-             h2 = SQRT( SQRT( 1.0_wp - 16.0_wp * rifs * z0(j,i) / zp ) )
-
-             wall_flux(k) = kappa * vel_zp / (                                 &
-                  LOG( zp / z0(j,i) ) -                                        &
-                  LOG( ( 1.0_wp + h1 )**2 * ( 1.0_wp + h1**2 ) / (             &
-                       ( 1.0_wp + h2 )**2 * ( 1.0_wp + h2**2 )   ) ) +         &
-                       2.0_wp * ( ATAN( h1 ) - ATAN( h2 ) )                    &
-                                             )
-          ENDIF
-          wall_flux(k) = - wall_flux(k) * us_wall
-
-       ENDDO
-
-    END SUBROUTINE wall_fluxes_e_ij
-
- END MODULE wall_fluxes_mod
